PX152PST ;ALB/SCK - PX*1.0*52 POST INIT INSTALL
;;1.0;PCE PATIENT CARE ENCOUNTER;**52**;Aug 12, 1996
Q
;
EN ; Replace blank space holder with PXCE GAF protocol
N PX1,PX2,PX3,DA
D BMES^XPDUTL("Removing the blank space holder from the PXCE SDAM MENU")
D MES^XPDUTL("This space will be replaced by the GAF Score protocol.")
;
S PX1=$O(^ORD(101,"B","PXCE SDAM MENU",0))
I '$G(PX1) D G ENQ
. D MES^XPDUTL("Warning ... Unable to locate PXCE SDAM MENU protocol")
;
S PX2=$O(^ORD(101,"B","PXCE BLANK 1",0))
G:'$G(PX2) ENQ
S PX3=$O(^ORD(101,PX1,10,"B",PX2,0))
G:'$G(PX3) ENQ
;
S DA(1)=PX1,DA=PX3
S DIK="^ORD(101,"_DA(1)_",10,"
D ^DIK K DIK
D BMES^XPDUTL("Space holder removed...")
ENQ Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPX152PST 722 printed Oct 16, 2024@18:26:17 Page 2
PX152PST ;ALB/SCK - PX*1.0*52 POST INIT INSTALL
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**52**;Aug 12, 1996
+2 QUIT
+3 ;
EN ; Replace blank space holder with PXCE GAF protocol
+1 NEW PX1,PX2,PX3,DA
+2 DO BMES^XPDUTL("Removing the blank space holder from the PXCE SDAM MENU")
+3 DO MES^XPDUTL("This space will be replaced by the GAF Score protocol.")
+4 ;
+5 SET PX1=$ORDER(^ORD(101,"B","PXCE SDAM MENU",0))
+6 IF '$GET(PX1)
Begin DoDot:1
+7 DO MES^XPDUTL("Warning ... Unable to locate PXCE SDAM MENU protocol")
End DoDot:1
GOTO ENQ
+8 ;
+9 SET PX2=$ORDER(^ORD(101,"B","PXCE BLANK 1",0))
+10 if '$GET(PX2)
GOTO ENQ
+11 SET PX3=$ORDER(^ORD(101,PX1,10,"B",PX2,0))
+12 if '$GET(PX3)
GOTO ENQ
+13 ;
+14 SET DA(1)=PX1
SET DA=PX3
+15 SET DIK="^ORD(101,"_DA(1)_",10,"
+16 DO ^DIK
KILL DIK
+17 DO BMES^XPDUTL("Space holder removed...")
ENQ QUIT
