EDP2PST ;SLC/BWF - Post-init for facility install ;5/28/12 10:30am
;;2.0;EMERGENCY DEPARTMENT;**6**;Feb 24, 2012;Build 200
;
D CONVERT,UPDWKS,DEFROOM,REMX9999
Q
;
CONVERT ; convert old role values (set of codes) to new pointer structure
; old role values of 'P','R', and 'N' must match one of the new role
; abbreviations in the CPE role file.
N IEN,DAT,OROLE,NROLEPTR,ERR
S IEN=0 F S IEN=$O(^EDPB(231.7,IEN)) Q:'IEN D
.S DAT=$G(^EDPB(231.7,IEN,0))
.S OROLE=$P(DAT,U,6) Q:OROLE=""!(OROLE>0)
.; if OROLE is numeric, it has already been converted, so quit.
.I OROLE,$D(^EDPB(232.5,OROLE)) Q
.; if this particular role cannot be mapped, set it to null.
.S NROLEPTR=$O(^EDPB(232.5,"C",OROLE,"")) S:'NROLEPTR NROLEPTR=""
.S FDA(231.7,IEN_",",.06)=NROLEPTR D FILE^DIE(,"FDA","ERR") K FDA
Q
UPDWKS ; update all worksheets with the proper institution/area
N WKS,EDPSITE,EDPSTA
Q:'$D(DUZ)
S EDPSITE=DUZ(2),EDPSTA=$$STA^XUAF4(DUZ(2))
S WKS=0 F S WKS=$O(^EDPB(232.6,WKS)) Q:'WKS D
.S FDA(232.6,WKS_",",.02)=EDPSITE
.S FDA(232.6,WKS_",",.03)=EDPSTA
.D FILE^DIE(,"FDA")
Q
DEFROOM ;
N INST,AREA,DEFSTAT,NEWIEN,NRIEN
; do not add EDIS_DEFAULT if it already exists.
Q:$D(^EDPB(231.8,"B","EDIS_DEFAULT"))
S INST=$G(DUZ(2)) I 'INST D Q
.D MES^XPDUTL("Missing or invalid institution. Cannot Continue.")
.S XPDABORT=1
S AREA=$O(^EDPB(231.9,"C",DUZ(2),0))
I 'AREA D Q
.D MES^XPDUTL("Missing or invalid Area. Please check your TRACKING AREA file and insure there is an area associated with your institution.")
.S XPDABORT=1
S DEFSTAT=$O(^EDPB(233.1,"B","edp.status.waiting",0))
S FDA(231.8,"+1,",.01)="EDIS_DEFAULT"
S FDA(231.8,"+1,",.02)=INST
S FDA(231.8,"+1,",.03)=AREA
S FDA(231.8,"+1,",.05)=.1
S FDA(231.8,"+1,",.06)="EDIS_DEFAULT"
S FDA(231.8,"+1,",.07)=0
S FDA(231.8,"+1,",.08)=DEFSTAT
S FDA(231.8,"+1,",.09)=1
S FDA(231.8,"+1,",.11)=""
S FDA(231.8,"+1,",.13)=1
D UPDATE^DIE(,"FDA","NEWIEN")
S NRIEN=0,NRIEN=$O(NEWIEN(NRIEN)) S NRIEN=$G(NEWIEN(NRIEN))
Q
REMX9999 ; Loop through all display boards and rebuild definitions, removing '@last4' and '@alerts'.
N AREA,BID,BATT,BATTDAT,ATTRIB,CTR
S AREA=0 F S AREA=$O(^EDPB(231.9,AREA)) Q:'AREA D
.S CTR=0
.S PTNM=$$SRCHPTNM(AREA)
.I 'PTNM S CTR=$G(CTR)+1,ATTRIB(CTR)=$$PTNM()
.S BID=0 F S BID=$O(^EDPB(231.9,AREA,4,BID)) Q:'BID D
..S IENS=BID_","_AREA_","
..S BATT=0 F S BATT=$O(^EDPB(231.9,AREA,4,BID,1,BATT)) Q:'BATT D
...S BATTDAT=$G(^EDPB(231.9,AREA,4,BID,1,BATT,0))
...Q:BATTDAT["@last4"!(BATTDAT["@alerts")
...S CTR=$G(CTR)+1,ATTRIB(CTR)=BATTDAT
..D WP^DIE(231.94,IENS,1,"K","ATTRIB") K ATTRIB
Q
SRCHPTNM(AREA) ;
N BID,X,RET
S RET=0
S BID=0 F S BID=$O(^EDPB(231.9,AREA,4,BID)) Q:'BID D
.S X=0 F S X=$O(^EDPB(231.9,AREA,4,BID,1,X)) Q:'X!(RET) D
..I $G(^EDPB(231.9,AREA,4,BID,1,X,0))["@ptNm" S RET=1
Q RET
PTNM() ;
Q "<col att=""@ptNm"" header=""Patient"" color="""" width=""60"" label=""Patient Name""/>"
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEDP2PST 2999 printed Dec 13, 2024@01:51:26 Page 2
EDP2PST ;SLC/BWF - Post-init for facility install ;5/28/12 10:30am
+1 ;;2.0;EMERGENCY DEPARTMENT;**6**;Feb 24, 2012;Build 200
+2 ;
+3 DO CONVERT
DO UPDWKS
DO DEFROOM
DO REMX9999
+4 QUIT
+5 ;
CONVERT ; convert old role values (set of codes) to new pointer structure
+1 ; old role values of 'P','R', and 'N' must match one of the new role
+2 ; abbreviations in the CPE role file.
+3 NEW IEN,DAT,OROLE,NROLEPTR,ERR
+4 SET IEN=0
FOR
SET IEN=$ORDER(^EDPB(231.7,IEN))
if 'IEN
QUIT
Begin DoDot:1
+5 SET DAT=$GET(^EDPB(231.7,IEN,0))
+6 SET OROLE=$PIECE(DAT,U,6)
if OROLE=""!(OROLE>0)
QUIT
+7 ; if OROLE is numeric, it has already been converted, so quit.
+8 IF OROLE
IF $DATA(^EDPB(232.5,OROLE))
QUIT
+9 ; if this particular role cannot be mapped, set it to null.
+10 SET NROLEPTR=$ORDER(^EDPB(232.5,"C",OROLE,""))
if 'NROLEPTR
SET NROLEPTR=""
+11 SET FDA(231.7,IEN_",",.06)=NROLEPTR
DO FILE^DIE(,"FDA","ERR")
KILL FDA
End DoDot:1
+12 QUIT
UPDWKS ; update all worksheets with the proper institution/area
+1 NEW WKS,EDPSITE,EDPSTA
+2 if '$DATA(DUZ)
QUIT
+3 SET EDPSITE=DUZ(2)
SET EDPSTA=$$STA^XUAF4(DUZ(2))
+4 SET WKS=0
FOR
SET WKS=$ORDER(^EDPB(232.6,WKS))
if 'WKS
QUIT
Begin DoDot:1
+5 SET FDA(232.6,WKS_",",.02)=EDPSITE
+6 SET FDA(232.6,WKS_",",.03)=EDPSTA
+7 DO FILE^DIE(,"FDA")
End DoDot:1
+8 QUIT
DEFROOM ;
+1 NEW INST,AREA,DEFSTAT,NEWIEN,NRIEN
+2 ; do not add EDIS_DEFAULT if it already exists.
+3 if $DATA(^EDPB(231.8,"B","EDIS_DEFAULT"))
QUIT
+4 SET INST=$GET(DUZ(2))
IF 'INST
Begin DoDot:1
+5 DO MES^XPDUTL("Missing or invalid institution. Cannot Continue.")
+6 SET XPDABORT=1
End DoDot:1
QUIT
+7 SET AREA=$ORDER(^EDPB(231.9,"C",DUZ(2),0))
+8 IF 'AREA
Begin DoDot:1
+9 DO MES^XPDUTL("Missing or invalid Area. Please check your TRACKING AREA file and insure there is an area associated with your institution.")
+10 SET XPDABORT=1
End DoDot:1
QUIT
+11 SET DEFSTAT=$ORDER(^EDPB(233.1,"B","edp.status.waiting",0))
+12 SET FDA(231.8,"+1,",.01)="EDIS_DEFAULT"
+13 SET FDA(231.8,"+1,",.02)=INST
+14 SET FDA(231.8,"+1,",.03)=AREA
+15 SET FDA(231.8,"+1,",.05)=.1
+16 SET FDA(231.8,"+1,",.06)="EDIS_DEFAULT"
+17 SET FDA(231.8,"+1,",.07)=0
+18 SET FDA(231.8,"+1,",.08)=DEFSTAT
+19 SET FDA(231.8,"+1,",.09)=1
+20 SET FDA(231.8,"+1,",.11)=""
+21 SET FDA(231.8,"+1,",.13)=1
+22 DO UPDATE^DIE(,"FDA","NEWIEN")
+23 SET NRIEN=0
SET NRIEN=$ORDER(NEWIEN(NRIEN))
SET NRIEN=$GET(NEWIEN(NRIEN))
+24 QUIT
REMX9999 ; Loop through all display boards and rebuild definitions, removing '@last4' and '@alerts'.
+1 NEW AREA,BID,BATT,BATTDAT,ATTRIB,CTR
+2 SET AREA=0
FOR
SET AREA=$ORDER(^EDPB(231.9,AREA))
if 'AREA
QUIT
Begin DoDot:1
+3 SET CTR=0
+4 SET PTNM=$$SRCHPTNM(AREA)
+5 IF 'PTNM
SET CTR=$GET(CTR)+1
SET ATTRIB(CTR)=$$PTNM()
+6 SET BID=0
FOR
SET BID=$ORDER(^EDPB(231.9,AREA,4,BID))
if 'BID
QUIT
Begin DoDot:2
+7 SET IENS=BID_","_AREA_","
+8 SET BATT=0
FOR
SET BATT=$ORDER(^EDPB(231.9,AREA,4,BID,1,BATT))
if 'BATT
QUIT
Begin DoDot:3
+9 SET BATTDAT=$GET(^EDPB(231.9,AREA,4,BID,1,BATT,0))
+10 if BATTDAT["@last4"!(BATTDAT["@alerts")
QUIT
+11 SET CTR=$GET(CTR)+1
SET ATTRIB(CTR)=BATTDAT
End DoDot:3
+12 DO WP^DIE(231.94,IENS,1,"K","ATTRIB")
KILL ATTRIB
End DoDot:2
End DoDot:1
+13 QUIT
SRCHPTNM(AREA) ;
+1 NEW BID,X,RET
+2 SET RET=0
+3 SET BID=0
FOR
SET BID=$ORDER(^EDPB(231.9,AREA,4,BID))
if 'BID
QUIT
Begin DoDot:1
+4 SET X=0
FOR
SET X=$ORDER(^EDPB(231.9,AREA,4,BID,1,X))
if 'X!(RET)
QUIT
Begin DoDot:2
+5 IF $GET(^EDPB(231.9,AREA,4,BID,1,X,0))["@ptNm"
SET RET=1
End DoDot:2
End DoDot:1
+6 QUIT RET
PTNM() ;
+1 QUIT "<col att=""@ptNm"" header=""Patient"" color="""" width=""60"" label=""Patient Name""/>"
