SROA38A.m

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

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