SROASWP0.m

SROASWP0 ;B'HAM ISC/MAM - DELETE NO ASSESSMENTS ; 22 APR 1992  12:00 pm

 ;;3.0; Surgery ;;24 Jun 93

 I '$O(^SRA(0)) D DESTROY Q

 W !!,"Risk Assessment Pre-Conversion: "

 W !!,"Deleting all entries from the SURGERY RISK ASSESSMENT file (139) which do not",!,"contain assessment information or have an operation date prior to the ",!,"selected start date."

 K ^TMP("CONVERT") S ^TMP("CONVERT","NO ASSESS",1)="Entries in the SURGERY RISK ASSESSMENT file (139) which were deleted"

 S ^TMP("CONVERT","NO ASSESS",2)="because they contained no assessment information, or had an operation date",^TMP("CONVERT","NO ASSESS",3)="prior to the selected start date."

 S ^TMP("CONVERT","NO ASSESS",4)=" "

 S SRCNT=4,SRAN=0 F  S SRAN=$O(^SRA(SRAN)) Q:'SRAN  S SRA("S")=$G(^SRA(SRAN,"S")),SRTYPE=$P(SRA("S"),"^",2),STATUS=$P(SRA("S"),"^",6) I STATUS'="Y",SRTYPE="N" W "." D MSGLINE,DELETE

 S SRCNT=4,SRAN=0 F  S SRAN=$O(^SRA(SRAN)) Q:'SRAN  D CHECK I SRADEL W "." D MSGLINE,DELETE

 I $D(^TMP("CONVERT","NO ASSESS",5)) D SENDMSG

 K ^TMP("CONVERT") D ^SROASWP1

 Q

CHECK ; determine if assessment should be deleted

 S SRADEL=0 I $P(^SRA(SRAN,0),"^",5)<SRDATE S SRADEL=1 Q

 S SRA("S")=$G(^SRA(SRAN,"S")),SRTYPE=$P(SRA("S"),"^",2),STATUS=$P(SRA("S"),"^",6) I STATUS'="Y",SRTYPE="N" S SRADEL=1

 Q

DELETE ; delete assessment from 139

 S DA=SRAN,DIK="^SRA(" D ^DIK Q

 Q

MSGLINE ; store info for mail message

 S SRA(0)=^SRA(SRAN,0),DFN=$P(SRA(0),"^") D DEM^VADPT S SRANAME=VADM(1)_" ("_VA("PID")_")",DATE=$P(SRA(0),"^",5),DATE=$E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3)

 S SRCNT=SRCNT+1,^TMP("CONVERT","NO ASSESS",SRCNT)=SRANAME_"    DATE OF OPERATION: "_DATE

 Q

SENDMSG ; send mail message

 S XMY("G.RISK ASSESSMENT@"_^XMB("NETNAME"))=""

 S XMSUB="RISK ASSESSMENT ENTRIES NOT CONVERTED, NO ASSESSMENT INFORMATION",XMDUZ="RISK ASSESSMENT CONVERSION",XMTEXT="^TMP(""CONVERT"",""NO ASSESS"","

 N I D ^XMD K XMSUB,XMDUZ,XMTEXT,XMY

 Q

DESTROY ; destroy SROA CONVERT option

 S SRCONV=$O(^DIC(19,"B","SROA CONVERT",0)) I 'SRCONV Q

 K DA,DIK S DA=SRCONV,DIK="^DIC(19," D ^DIK

 Q

SROASWP0  ;B'HAM ISC/MAM - DELETE NO ASSESSMENTS ; 22 APR 1992  12:00 pm

 +1       ;;3.0; Surgery ;;24 Jun 93

 +2        IF '$ORDER(^SRA(0))

               DO DESTROY

               QUIT 

 +3        WRITE !!,"Risk Assessment Pre-Conversion: "

 +4        WRITE !!,"Deleting all entries from the SURGERY RISK ASSESSMENT file (139) which do not",!,"contain assessment information or have an operation date prior to the ",!,"selected start date."

 +5        KILL ^TMP("CONVERT")

           SET ^TMP("CONVERT","NO ASSESS",1)="Entries in the SURGERY RISK ASSESSMENT file (139) which were deleted"

 +6        SET ^TMP("CONVERT","NO ASSESS",2)="because they contained no assessment information, or had an operation date"

           SET ^TMP("CONVERT","NO ASSESS",3)="prior to the selected start date."

 +7        SET ^TMP("CONVERT","NO ASSESS",4)=" "

 +8        SET SRCNT=4

           SET SRAN=0

           FOR 

               SET SRAN=$ORDER(^SRA(SRAN))

               IF 'SRAN

                   QUIT 

               SET SRA("S")=$GET(^SRA(SRAN,"S"))

               SET SRTYPE=$PIECE(SRA("S"),"^",2)

               SET STATUS=$PIECE(SRA("S"),"^",6)

               IF STATUS'="Y"

                   IF SRTYPE="N"

                       WRITE "."

                       DO MSGLINE

                       DO DELETE

 +9        SET SRCNT=4

           SET SRAN=0

           FOR 

               SET SRAN=$ORDER(^SRA(SRAN))

               IF 'SRAN

                   QUIT 

               DO CHECK

               IF SRADEL

                   WRITE "."

                   DO MSGLINE

                   DO DELETE

 +10       IF $DATA(^TMP("CONVERT","NO ASSESS",5))

               DO SENDMSG

 +11       KILL ^TMP("CONVERT")

           DO ^SROASWP1

 +12       QUIT 

CHECK     ; determine if assessment should be deleted

 +1        SET SRADEL=0

           IF $PIECE(^SRA(SRAN,0),"^",5)<SRDATE

               SET SRADEL=1

               QUIT 

 +2        SET SRA("S")=$GET(^SRA(SRAN,"S"))

           SET SRTYPE=$PIECE(SRA("S"),"^",2)

           SET STATUS=$PIECE(SRA("S"),"^",6)

           IF STATUS'="Y"

               IF SRTYPE="N"

                   SET SRADEL=1

 +3        QUIT 

DELETE    ; delete assessment from 139

 +1        SET DA=SRAN

           SET DIK="^SRA("

           DO ^DIK

           QUIT 

 +2        QUIT 

MSGLINE   ; store info for mail message

 +1        SET SRA(0)=^SRA(SRAN,0)

           SET DFN=$PIECE(SRA(0),"^")

           DO DEM^VADPT

           SET SRANAME=VADM(1)_" ("_VA("PID")_")"

           SET DATE=$PIECE(SRA(0),"^",5)

           SET DATE=$EXTRACT(DATE,4,5)_"/"_$EXTRACT(DATE,6,7)_"/"_$EXTRACT(DATE,2,3)

 +2        SET SRCNT=SRCNT+1

           SET ^TMP("CONVERT","NO ASSESS",SRCNT)=SRANAME_"    DATE OF OPERATION: "_DATE

 +3        QUIT 

SENDMSG   ; send mail message

 +1        SET XMY("G.RISK ASSESSMENT@"_^XMB("NETNAME"))=""

 +2        SET XMSUB="RISK ASSESSMENT ENTRIES NOT CONVERTED, NO ASSESSMENT INFORMATION"

           SET XMDUZ="RISK ASSESSMENT CONVERSION"

           SET XMTEXT="^TMP(""CONVERT"",""NO ASSESS"","

 +3        NEW I

           DO ^XMD

           KILL XMSUB,XMDUZ,XMTEXT,XMY

 +4        QUIT 

DESTROY   ; destroy SROA CONVERT option

 +1        SET SRCONV=$ORDER(^DIC(19,"B","SROA CONVERT",0))

           IF 'SRCONV

               QUIT 

 +2        KILL DA,DIK

           SET DA=SRCONV

           SET DIK="^DIC(19,"

           DO ^DIK

 +3        QUIT