- 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
