Released DG*5.3*810 SEQ #720 Extracted from mail message **KIDS**:DG*5.3*810^ **INSTALL NAME** DG*5.3*810 "BLD",7191,0) DG*5.3*810^REGISTRATION^0^3090515^y "BLD",7191,4,0) ^9.64PA^^ "BLD",7191,6.3) 1 "BLD",7191,"ABPKG") n "BLD",7191,"KRN",0) ^9.67PA^8989.52^19 "BLD",7191,"KRN",.4,0) .4 "BLD",7191,"KRN",.401,0) .401 "BLD",7191,"KRN",.402,0) .402 "BLD",7191,"KRN",.403,0) .403 "BLD",7191,"KRN",.5,0) .5 "BLD",7191,"KRN",.84,0) .84 "BLD",7191,"KRN",3.6,0) 3.6 "BLD",7191,"KRN",3.8,0) 3.8 "BLD",7191,"KRN",9.2,0) 9.2 "BLD",7191,"KRN",9.8,0) 9.8 "BLD",7191,"KRN",9.8,"NM",0) ^9.68A^1^1 "BLD",7191,"KRN",9.8,"NM",1,0) DGENPTA1^^0^B20979980 "BLD",7191,"KRN",9.8,"NM","B","DGENPTA1",1) "BLD",7191,"KRN",19,0) 19 "BLD",7191,"KRN",19.1,0) 19.1 "BLD",7191,"KRN",101,0) 101 "BLD",7191,"KRN",409.61,0) 409.61 "BLD",7191,"KRN",771,0) 771 "BLD",7191,"KRN",870,0) 870 "BLD",7191,"KRN",8989.51,0) 8989.51 "BLD",7191,"KRN",8989.52,0) 8989.52 "BLD",7191,"KRN",8994,0) 8994 "BLD",7191,"KRN","B",.4,.4) "BLD",7191,"KRN","B",.401,.401) "BLD",7191,"KRN","B",.402,.402) "BLD",7191,"KRN","B",.403,.403) "BLD",7191,"KRN","B",.5,.5) "BLD",7191,"KRN","B",.84,.84) "BLD",7191,"KRN","B",3.6,3.6) "BLD",7191,"KRN","B",3.8,3.8) "BLD",7191,"KRN","B",9.2,9.2) "BLD",7191,"KRN","B",9.8,9.8) "BLD",7191,"KRN","B",19,19) "BLD",7191,"KRN","B",19.1,19.1) "BLD",7191,"KRN","B",101,101) "BLD",7191,"KRN","B",409.61,409.61) "BLD",7191,"KRN","B",771,771) "BLD",7191,"KRN","B",870,870) "BLD",7191,"KRN","B",8989.51,8989.51) "BLD",7191,"KRN","B",8989.52,8989.52) "BLD",7191,"KRN","B",8994,8994) "BLD",7191,"QDEF") ^^^^NO^^^^NO^^NO "BLD",7191,"QUES",0) ^9.62^^ "BLD",7191,"REQB",0) ^9.611^1^1 "BLD",7191,"REQB",1,0) DG*5.3*688^2 "BLD",7191,"REQB","B","DG*5.3*688",1) "MBREQ") 0 "PKG",47,-1) 1^1 "PKG",47,0) REGISTRATION^DG^PATIENT REGISTRATION, ADMISSION, DISCHARGE, EMBOSSER "PKG",47,20,0) ^9.402P^^ "PKG",47,22,0) ^9.49I^1^1 "PKG",47,22,1,0) 5.3^2930813^2960613 "PKG",47,22,1,"PAH",1,0) 810^3090515 "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") NO "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 1 "RTN","DGENPTA1") 0^1^B20979980^B20787602 "RTN","DGENPTA1",1,0) DGENPTA1 ;ALB/CJM,EG,CKN,ERC,TDM - Patient API - File Data ; 5/15/09 11:16am "RTN","DGENPTA1",2,0) ;;5.3;Registration;**121,147,314,677,659,653,688,810**;Aug 13,1993;Build 1 "RTN","DGENPTA1",3,0) ; "RTN","DGENPTA1",4,0) LOCK(DFN) ; "RTN","DGENPTA1",5,0) ;Description: Given an internal entry number of a PATIENT record, this "RTN","DGENPTA1",6,0) ; function will lock the record. It should be used when updating the "RTN","DGENPTA1",7,0) ; record. "RTN","DGENPTA1",8,0) ;Input: "RTN","DGENPTA1",9,0) ; DFN - Patient IEN "RTN","DGENPTA1",10,0) ;Output: "RTN","DGENPTA1",11,0) ; Function Value - Returns 1 if the lock was successful, 0 otherwise "RTN","DGENPTA1",12,0) ; "RTN","DGENPTA1",13,0) I $G(DFN) L +^DPT(DFN):2 "RTN","DGENPTA1",14,0) Q $T "RTN","DGENPTA1",15,0) UNLOCK(DFN) ; "RTN","DGENPTA1",16,0) ;Description: Given an internal entry number of a record in the PATIENT "RTN","DGENPTA1",17,0) ; file, this function will unlock the record that was previously "RTN","DGENPTA1",18,0) ; locked by LOCK PATIENT RECORD. "RTN","DGENPTA1",19,0) ;Input: "RTN","DGENPTA1",20,0) ; DFN - Patient IEN "RTN","DGENPTA1",21,0) ;Output: None "RTN","DGENPTA1",22,0) ; "RTN","DGENPTA1",23,0) I $G(DFN) L -^DPT(DFN) "RTN","DGENPTA1",24,0) Q "RTN","DGENPTA1",25,0) ; "RTN","DGENPTA1",26,0) STOREPRE(DFN,DGPREFAC) ; "RTN","DGENPTA1",27,0) ;Description: Used to store the patient's preferred facility in the "RTN","DGENPTA1",28,0) ; patient record. "RTN","DGENPTA1",29,0) ;Input: "RTN","DGENPTA1",30,0) ; DFN - Patient IEN "RTN","DGENPTA1",31,0) ; DGPREFAC - pointer to the a record in the INSTITUTION file. "RTN","DGENPTA1",32,0) ;Output: "RTN","DGENPTA1",33,0) ; Function Value - Returns 1 on success, 0 on failure. "RTN","DGENPTA1",34,0) ; "RTN","DGENPTA1",35,0) N SUCCESS,DATA "RTN","DGENPTA1",36,0) S SUCCESS=1 "RTN","DGENPTA1",37,0) D ;drops out if invalid condition found "RTN","DGENPTA1",38,0) . I $G(DFN),$D(^DPT(DFN,0)) "RTN","DGENPTA1",39,0) . E S SUCCESS=0 Q "RTN","DGENPTA1",40,0) . I ($G(DGPREFAC)'=""),'$G(DGPREFAC) S SUCCESS=0 Q "RTN","DGENPTA1",41,0) . I $G(DGPREFAC),'$D(^DIC(4,DGPREFAC,0)) S SUCCESS=0 Q "RTN","DGENPTA1",42,0) . S DATA(27.02)=DGPREFAC "RTN","DGENPTA1",43,0) . S SUCESS=$$UPD^DGENDBS(2,DFN,.DATA) "RTN","DGENPTA1",44,0) Q SUCCESS "RTN","DGENPTA1",45,0) ; "RTN","DGENPTA1",46,0) CHECK(DGPAT,ERROR) ; "RTN","DGENPTA1",47,0) ;Description: Does validation checks on the patient contained in the "RTN","DGENPTA1",48,0) ;DGPAT array. "RTN","DGENPTA1",49,0) ; "RTN","DGENPTA1",50,0) ;Input: "RTN","DGENPTA1",51,0) ; DGPAT - this local array contains patient data "RTN","DGENPTA1",52,0) ;Output: "RTN","DGENPTA1",53,0) ; Function Value - returns 1 if all validation checks passed, 0 otherwise "RTN","DGENPTA1",54,0) ; ERROR - if validation checks fail, an error message is returned (pass by reference) "RTN","DGENPTA1",55,0) ; "RTN","DGENPTA1",56,0) ; "RTN","DGENPTA1",57,0) N SUCCESS,FIELD "RTN","DGENPTA1",58,0) S SUCCESS=1 "RTN","DGENPTA1",59,0) S ERROR="" "RTN","DGENPTA1",60,0) ; "RTN","DGENPTA1",61,0) ;check field values "RTN","DGENPTA1",62,0) ; "RTN","DGENPTA1",63,0) ;some of the field's input transforms require DA or DUZ to be defined, so do not do this "RTN","DGENPTA1",64,0) ;F S SUB=$O(DGPAT(SUB)) Q:SUB="" D:(DGPAT(SUB)'="") Q:'SUCCESS "RTN","DGENPTA1",65,0) ;.S FIELD=$$FIELD(SUB) "RTN","DGENPTA1",66,0) ;.I '$$TESTVAL^DGENDBS(2,FIELD,DGPAT(SUB)) D "RTN","DGENPTA1",67,0) ;..S SUCCESS=0 "RTN","DGENPTA1",68,0) ;..S ERROR="BAD FIELD VALUE, PATIENT FILE FIELD = "_$$GET1^DID(2,FIELD,,"LABEL") "RTN","DGENPTA1",69,0) ; "RTN","DGENPTA1",70,0) ;instead, check field values without referencing DD "RTN","DGENPTA1",71,0) I DGPAT("INELDEC")'="",($L(DGPAT("INELDEC"))>75)!($L(DGPAT("INELDEC"))<3) S SUCCESS=0,ERROR="BAD FIELD VALUE, PATIENT FIELD FIELD = INELIGIBLE VARO DECISION" G QCHECK "RTN","DGENPTA1",72,0) ; "RTN","DGENPTA1",73,0) I DGPAT("INELREA")'="",($L(DGPAT("INELREA"))>40) S SUCCESS=0,ERROR="BAD FIELD VALUE, PATIENT FIELD FIELD = INELIGIBLE REASON" G QCHECK "RTN","DGENPTA1",74,0) ; "RTN","DGENPTA1",75,0) I DGPAT("VETERAN")="" S SUCCESS=0,ERROR="BAD FIELD VALUE, PATIENT FIELD = VETERAN (Y/N)?" G QCHECK "RTN","DGENPTA1",76,0) ; "RTN","DGENPTA1",77,0) I DGPAT("DEATH"),(DGPAT("DEATH")>DT) S SUCCESS=0,ERROR="DATE OF DEATH CAN NOT BE A FUTURE DATE" G QCHECK "RTN","DGENPTA1",78,0) ; "RTN","DGENPTA1",79,0) I DGPAT("INELDATE"),(DGPAT("INELREA")="") S SUCCESS=0,ERROR="INELIGIBLE REASON UNSPECIFIED FOR INELIGIBLE PATIENT" G QCHECK "RTN","DGENPTA1",80,0) ; "RTN","DGENPTA1",81,0) QCHECK ; "RTN","DGENPTA1",82,0) Q SUCCESS "RTN","DGENPTA1",83,0) ; "RTN","DGENPTA1",84,0) STORE(DGPAT,ERROR,NOCHECK) ; "RTN","DGENPTA1",85,0) ;Description: Files data in the patient record. It requires a lock "RTN","DGENPTA1",86,0) ;on the Patient record, adn releases the lock when done. "RTN","DGENPTA1",87,0) ; "RTN","DGENPTA1",88,0) ;Input: "RTN","DGENPTA1",89,0) ; DGPAT- the patient array, passed by reference "RTN","DGENPTA1",90,0) ; NOCHECK - a flag, if set to 1 it means consistency checks were done aready, so skip "RTN","DGENPTA1",91,0) ; "RTN","DGENPTA1",92,0) ;Output: "RTN","DGENPTA1",93,0) ; Function Value - returns 1 if successful, otherwise 0 "RTN","DGENPTA1",94,0) ; ERROR - on failure, an error message is returned (optional, pass by reference) "RTN","DGENPTA1",95,0) ; "RTN","DGENPTA1",96,0) S ERROR="" "RTN","DGENPTA1",97,0) I '$D(DGPAT) S ERROR="PATIENT NOT FOUND" Q 0 "RTN","DGENPTA1",98,0) I '$$LOCK(DGPAT("DFN")) S ERROR="UNABLE TO LOCK THE PATIENT RECORD" Q 0 "RTN","DGENPTA1",99,0) I $G(NOCHECK)'=1 Q:'$$CHECK(.DGPAT,.ERROR) 0 "RTN","DGENPTA1",100,0) ; "RTN","DGENPTA1",101,0) N DATA,SUB,FIELD,SUCCESS "RTN","DGENPTA1",102,0) S SUB="" "RTN","DGENPTA1",103,0) ; "RTN","DGENPTA1",104,0) F S SUB=$O(DGPAT(SUB)) Q:(SUB="") I (SUB'="DEATH")&(SUB'="SSN") S FIELD=$$FIELD(SUB) I FIELD S DATA(FIELD)=$G(DGPAT(SUB)) "RTN","DGENPTA1",105,0) S SUCCESS=$$UPD^DGENDBS(2,DGPAT("DFN"),.DATA) "RTN","DGENPTA1",106,0) I 'SUCCESS S ERROR="FILEMAN UNABLE TO UPDATE PATIENT RECORD" "RTN","DGENPTA1",107,0) ; Call Purple Heart API to file PH data in file 2 "RTN","DGENPTA1",108,0) I SUCCESS,$D(DGPAT("PHI")) D EDITPH^DGRPLE($G(DGPAT("PHI")),$G(DGPAT("PHST")),$G(DGPAT("PHRR")),DGPAT("DFN")) "RTN","DGENPTA1",109,0) ; Call POW API to file POW data in file 2 - DG*5.3*653 "RTN","DGENPTA1",110,0) ;I SUCCESS,$D(DGPAT("POWI")) D EDITPOW^DGRPLE($G(DGPAT("POWI")),$G(DGPAT("POWLOC")),$G(DGPAT("POWFDT")),$G(DGPAT("POWTDT")),DGPAT("DFN")) "RTN","DGENPTA1",111,0) I SUCCESS D "RTN","DGENPTA1",112,0) . I '$D(DGPAT("POWI")) D Q "RTN","DGENPTA1",113,0) . . N DATA,ERROR,DGENDA "RTN","DGENPTA1",114,0) . . S DGENDA=DGPAT("DFN") "RTN","DGENPTA1",115,0) . . S (DATA(.525),DATA(.526),DATA(.527),DATA(.528),DATA(.529))="@" "RTN","DGENPTA1",116,0) . . I '$$UPD^DGENDBS(2,.DGENDA,.DATA,.ERROR) D "RTN","DGENPTA1",117,0) . . . D ADDMSG^DGENUPL3(.MSGS,"Unable to update POW Data.",1) "RTN","DGENPTA1",118,0) . . K DATA,ERROR,DGENDA "RTN","DGENPTA1",119,0) . D EDITPOW^DGRPLE($G(DGPAT("POWI")),$G(DGPAT("POWLOC")),$G(DGPAT("POWFDT")),$G(DGPAT("POWTDT")),DGPAT("DFN")) "RTN","DGENPTA1",120,0) D UNLOCK(DGPAT("DFN")) "RTN","DGENPTA1",121,0) Q SUCCESS "RTN","DGENPTA1",122,0) ; "RTN","DGENPTA1",123,0) FIELD(SUB) ; "RTN","DGENPTA1",124,0) ;Description: Returns the field number of a subscript for the PATIENT object. "RTN","DGENPTA1",125,0) ; "RTN","DGENPTA1",126,0) N FNUM "RTN","DGENPTA1",127,0) S FNUM=$S(SUB="DEATH":.351,SUB="PATYPE":391,SUB="VETERAN":1901,SUB="NAME":.01,SUB="DOB":.03,SUB="SEX":.02,SUB="SSN":.09,SUB="PREFAC":27.02,SUB="AG/ALLY":.309,1:"") "RTN","DGENPTA1",128,0) S:'FNUM FNUM=$S(SUB="INELDATE":.152,SUB="INELREA":.307,SUB="INELDEC":.1656,SUB="PID":.363,SUB="EMGRES":.181,1:"") "RTN","DGENPTA1",129,0) I FNUM="" S FNUM=$S(SUB="IR":.32103,SUB="RADEXPM":.3212,SUB="APPREQ":1010.159,SUB="APPREQDT":1010.1511,1:"") "RTN","DGENPTA1",130,0) Q FNUM "VER") 8.0^22.0 "BLD",7191,6) ^720 **END** **END**