SR3P177 ;ALB/AAS - Patch 177 pre-install;1 Mar 12
;;3.0;Surgery;**177**;24 Jun 93;Build 89
;
EN ;
N FLD,X,Y,DA,DIK
I $G(DUZ)="" W !,"Your DUZ is not defined. It must be defined to run this routine." Q
;
;Delete updated fields to remove screens.
N FLD,X,Y,DA,DIK
X ^%ZOSF("UCI") I Y["DEVESS" W !,"CAN'T BE RUN IN DEVESS",!,*7 Q
;
F FLD=32.5,66,253,286,343,344,392,489 D
. S DIK="^DD(130,",DA=FLD,DA(1)=130
. D ^DIK
;
;
S FLD=4 D
. S DIK="^DD(130.13,",DA=FLD,DA(1)=130.13
. D ^DIK
;
S FLD=3 D
. S DIK="^DD(130.17,",DA=FLD,DA(1)=130.17
. D ^DIK
;
S FLD=3 D
. S DIK="^DD(130.18,",DA=FLD,DA(1)=130.18
. D ^DIK
;
S FLD=6 D
. S DIK="^DD(130.22,",DA=FLD,DA(1)=130.22
. D ^DIK
;
S FLD=.03 D
. S DIK="^DD(136,",DA=FLD,DA(1)=136
. D ^DIK
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSR3P177 797 printed Nov 22, 2024@17:48:39 Page 2
SR3P177 ;ALB/AAS - Patch 177 pre-install;1 Mar 12
+1 ;;3.0;Surgery;**177**;24 Jun 93;Build 89
+2 ;
EN ;
+1 NEW FLD,X,Y,DA,DIK
+2 IF $GET(DUZ)=""
WRITE !,"Your DUZ is not defined. It must be defined to run this routine."
QUIT
+3 ;
+4 ;Delete updated fields to remove screens.
+5 NEW FLD,X,Y,DA,DIK
+6 XECUTE ^%ZOSF("UCI")
IF Y["DEVESS"
WRITE !,"CAN'T BE RUN IN DEVESS",!,*7
QUIT
+7 ;
+8 FOR FLD=32.5,66,253,286,343,344,392,489
Begin DoDot:1
+9 SET DIK="^DD(130,"
SET DA=FLD
SET DA(1)=130
+10 DO ^DIK
End DoDot:1
+11 ;
+12 ;
+13 SET FLD=4
Begin DoDot:1
+14 SET DIK="^DD(130.13,"
SET DA=FLD
SET DA(1)=130.13
+15 DO ^DIK
End DoDot:1
+16 ;
+17 SET FLD=3
Begin DoDot:1
+18 SET DIK="^DD(130.17,"
SET DA=FLD
SET DA(1)=130.17
+19 DO ^DIK
End DoDot:1
+20 ;
+21 SET FLD=3
Begin DoDot:1
+22 SET DIK="^DD(130.18,"
SET DA=FLD
SET DA(1)=130.18
+23 DO ^DIK
End DoDot:1
+24 ;
+25 SET FLD=6
Begin DoDot:1
+26 SET DIK="^DD(130.22,"
SET DA=FLD
SET DA(1)=130.22
+27 DO ^DIK
End DoDot:1
+28 ;
+29 SET FLD=.03
Begin DoDot:1
+30 SET DIK="^DD(136,"
SET DA=FLD
SET DA(1)=136
+31 DO ^DIK
End DoDot:1
