| 1 | SROASWP0 ;B'HAM ISC/MAM - DELETE NO ASSESSMENTS ; 22 APR 1992  12:00 pm
 | 
|---|
| 2 |  ;;3.0; Surgery ;;24 Jun 93
 | 
|---|
| 3 |  I '$O(^SRA(0)) D DESTROY Q
 | 
|---|
| 4 |  W !!,"Risk Assessment Pre-Conversion: "
 | 
|---|
| 5 |  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."
 | 
|---|
| 6 |  K ^TMP("CONVERT") S ^TMP("CONVERT","NO ASSESS",1)="Entries in the SURGERY RISK ASSESSMENT file (139) which were deleted"
 | 
|---|
| 7 |  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."
 | 
|---|
| 8 |  S ^TMP("CONVERT","NO ASSESS",4)=" "
 | 
|---|
| 9 |  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
 | 
|---|
| 10 |  S SRCNT=4,SRAN=0 F  S SRAN=$O(^SRA(SRAN)) Q:'SRAN  D CHECK I SRADEL W "." D MSGLINE,DELETE
 | 
|---|
| 11 |  I $D(^TMP("CONVERT","NO ASSESS",5)) D SENDMSG
 | 
|---|
| 12 |  K ^TMP("CONVERT") D ^SROASWP1
 | 
|---|
| 13 |  Q
 | 
|---|
| 14 | CHECK ; determine if assessment should be deleted
 | 
|---|
| 15 |  S SRADEL=0 I $P(^SRA(SRAN,0),"^",5)<SRDATE S SRADEL=1 Q
 | 
|---|
| 16 |  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
 | 
|---|
| 17 |  Q
 | 
|---|
| 18 | DELETE ; delete assessment from 139
 | 
|---|
| 19 |  S DA=SRAN,DIK="^SRA(" D ^DIK Q
 | 
|---|
| 20 |  Q
 | 
|---|
| 21 | MSGLINE ; store info for mail message
 | 
|---|
| 22 |  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)
 | 
|---|
| 23 |  S SRCNT=SRCNT+1,^TMP("CONVERT","NO ASSESS",SRCNT)=SRANAME_"    DATE OF OPERATION: "_DATE
 | 
|---|
| 24 |  Q
 | 
|---|
| 25 | SENDMSG ; send mail message
 | 
|---|
| 26 |  S XMY("G.RISK ASSESSMENT@"_^XMB("NETNAME"))=""
 | 
|---|
| 27 |  S XMSUB="RISK ASSESSMENT ENTRIES NOT CONVERTED, NO ASSESSMENT INFORMATION",XMDUZ="RISK ASSESSMENT CONVERSION",XMTEXT="^TMP(""CONVERT"",""NO ASSESS"","
 | 
|---|
| 28 |  N I D ^XMD K XMSUB,XMDUZ,XMTEXT,XMY
 | 
|---|
| 29 |  Q
 | 
|---|
| 30 | DESTROY ; destroy SROA CONVERT option
 | 
|---|
| 31 |  S SRCONV=$O(^DIC(19,"B","SROA CONVERT",0)) I 'SRCONV Q
 | 
|---|
| 32 |  K DA,DIK S DA=SRCONV,DIK="^DIC(19," D ^DIK
 | 
|---|
| 33 |  Q
 | 
|---|