SROA38A ;BIR/ADM-Preinitialization Process for SR*3*38 ; [ 05/18/95 1:50 PM ]
;;3.0; Surgery ;**38**;24 Jun 93
I $G(SR38DONE) G END
LOOP ; loop through each case and update anesthesia techniques to ABA list
W !!,"Converting anesthesia techniques..." S (CNT,SRTN)=0
F S SRTN=$O(^SRF(SRTN)) Q:'SRTN S CNT=CNT+1 W:'(CNT#100) "." I $O(^SRF(SRTN,6,0)) S SRANES=0 F S SRANES=$O(^SRF(SRTN,6,SRANES)) Q:'SRANES S X=$P($G(^SRF(SRTN,6,SRANES,0)),"^") I X'="" D
.S SRCASE=SRTN_"^"_SRANES_"^"_X
.S SRFLG=0 F SRTECH="INH","IV","S","E","INF","N","F","T","O" I X=SRTECH S SRFLG=1 Q
.I 'SRFLG,$D(SRATECH(X)) D ALTER Q
.I 'SRFLG D NONSTD Q
.I X="E"!(X="S") Q
.I X="INH" S Y="G" D SET Q
.I X="IV" S MAC=$P($G(^SRF(SRTN,6,SRANES,8)),"^") S Y=$S(MAC="Y":"M",1:"G") D SET Q
.S Z=$P($G(^SRF(SRTN,.3)),"^",8),CAT=$S(Z="A":1,Z="N":1,1:0)
.I X="INF"!(X="N")!(X="F")!(X="T")!(X="O") S Y=$S(CAT:"O",1:"L") D SET
W !,"Conversion of anesthesia techniques is finished.",!
STATUS ; change assessments with a status of COMPLETE to INCOMPLETE
F SRS="C","N" S DFN=0 F S DFN=$O(^SRF("ARS",SRS,"C",DFN)) Q:'DFN S SRTN=0 F S SRTN=$O(^SRF("ARS",SRS,"C",DFN,SRTN)) Q:'SRTN D
.I $P($G(^SRF(SRTN,"RA")),"^",6)="N" Q
.K ^SRF("ARS",SRS,"C",DFN,SRTN),DA,DIE,DR S DA=SRTN,DIE=130,DR="235////I;272///@" D ^DIE
DELDD ; delete DD for modified fields
K DIE,DR,DIK,DA S DIK="^DD(130,",DA(1)=130 F DA=102,218,235,256,259,287,339,340,404,411 D ^DIK
K DIK,DA
; delete DD's of sub-files with changed names
F SRSUB=130.053,130.534,130.0126,130.13,130.21,130.22,130.224 K DIU S DIU=SRSUB,DIU(0)="S" D EN^DIU2
K SRSUB,DIU
; delete occurrence categories in file 136.5
END K ^SRO(136.5)
W !!,"Preinit process is finished.",! K CAT,CNT,DFN,I,MAC,SR38DONE,SRA,SRANES,SRATECH,SRCASE,SRFLG,SRNON,SRS,SRSOUT,SRTECH,SRTN,SRW,SRX,SRX1,SRY,SRZ,X,Y,Z
Q
SET S $P(^SRF(SRTN,6,SRANES,0),"^")=Y
Q
NONSTD ; convert non-standard anesthesia technique
S Z=$P($G(^SRF(SRTN,.3)),"^",8),CAT=$S(Z="A":1,Z="N":1,1:0),Y=$S(CAT:"O",1:"L")
W !!,"Non-standard technique code "_X_" on case #"_SRTN_" converted to "_$S(Y="O":"OTHER",1:"LOCAL")_".",!
D SET
Q
ALTER S Y=SRATECH(X) D SET
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROA38A 2179 printed Apr 09, 2024@21:42:21 Page 2
SROA38A ;BIR/ADM-Preinitialization Process for SR*3*38 ; [ 05/18/95 1:50 PM ]
+1 ;;3.0; Surgery ;**38**;24 Jun 93
+2 IF $GET(SR38DONE)
GOTO END
LOOP ; loop through each case and update anesthesia techniques to ABA list
+1 WRITE !!,"Converting anesthesia techniques..."
SET (CNT,SRTN)=0
+2 FOR
SET SRTN=$ORDER(^SRF(SRTN))
if 'SRTN
QUIT
SET CNT=CNT+1
if '(CNT#100)
WRITE "."
IF $ORDER(^SRF(SRTN,6,0))
SET SRANES=0
FOR
SET SRANES=$ORDER(^SRF(SRTN,6,SRANES))
if 'SRANES
QUIT
SET X=$PIECE($GET(^SRF(SRTN,6,SRANES,0)),"^")
IF X'=""
Begin DoDot:1
+3 SET SRCASE=SRTN_"^"_SRANES_"^"_X
+4 SET SRFLG=0
FOR SRTECH="INH","IV","S","E","INF","N","F","T","O"
IF X=SRTECH
SET SRFLG=1
QUIT
+5 IF 'SRFLG
IF $DATA(SRATECH(X))
DO ALTER
QUIT
+6 IF 'SRFLG
DO NONSTD
QUIT
+7 IF X="E"!(X="S")
QUIT
+8 IF X="INH"
SET Y="G"
DO SET
QUIT
+9 IF X="IV"
SET MAC=$PIECE($GET(^SRF(SRTN,6,SRANES,8)),"^")
SET Y=$SELECT(MAC="Y":"M",1:"G")
DO SET
QUIT
+10 SET Z=$PIECE($GET(^SRF(SRTN,.3)),"^",8)
SET CAT=$SELECT(Z="A":1,Z="N":1,1:0)
+11 IF X="INF"!(X="N")!(X="F")!(X="T")!(X="O")
SET Y=$SELECT(CAT:"O",1:"L")
DO SET
End DoDot:1
+12 WRITE !,"Conversion of anesthesia techniques is finished.",!
STATUS ; change assessments with a status of COMPLETE to INCOMPLETE
+1 FOR SRS="C","N"
SET DFN=0
FOR
SET DFN=$ORDER(^SRF("ARS",SRS,"C",DFN))
if 'DFN
QUIT
SET SRTN=0
FOR
SET SRTN=$ORDER(^SRF("ARS",SRS,"C",DFN,SRTN))
if 'SRTN
QUIT
Begin DoDot:1
+2 IF $PIECE($GET(^SRF(SRTN,"RA")),"^",6)="N"
QUIT
+3 KILL ^SRF("ARS",SRS,"C",DFN,SRTN),DA,DIE,DR
SET DA=SRTN
SET DIE=130
SET DR="235////I;272///@"
DO ^DIE
End DoDot:1
DELDD ; delete DD for modified fields
+1 KILL DIE,DR,DIK,DA
SET DIK="^DD(130,"
SET DA(1)=130
FOR DA=102,218,235,256,259,287,339,340,404,411
DO ^DIK
+2 KILL DIK,DA
+3 ; delete DD's of sub-files with changed names
+4 FOR SRSUB=130.053,130.534,130.0126,130.13,130.21,130.22,130.224
KILL DIU
SET DIU=SRSUB
SET DIU(0)="S"
DO EN^DIU2
+5 KILL SRSUB,DIU
+6 ; delete occurrence categories in file 136.5
END KILL ^SRO(136.5)
+1 WRITE !!,"Preinit process is finished.",!
KILL CAT,CNT,DFN,I,MAC,SR38DONE,SRA,SRANES,SRATECH,SRCASE,SRFLG,SRNON,SRS,SRSOUT,SRTECH,SRTN,SRW,SRX,SRX1,SRY,SRZ,X,Y,Z
+2 QUIT
SET SET $PIECE(^SRF(SRTN,6,SRANES,0),"^")=Y
+1 QUIT
NONSTD ; convert non-standard anesthesia technique
+1 SET Z=$PIECE($GET(^SRF(SRTN,.3)),"^",8)
SET CAT=$SELECT(Z="A":1,Z="N":1,1:0)
SET Y=$SELECT(CAT:"O",1:"L")
+2 WRITE !!,"Non-standard technique code "_X_" on case #"_SRTN_" converted to "_$SELECT(Y="O":"OTHER",1:"LOCAL")_".",!
+3 DO SET
+4 QUIT
ALTER SET Y=SRATECH(X)
DO SET
+1 QUIT
