SROASWP2 ;B'HAM ISC/MAM - MOVE RISK TO FILE 130 ; 13 APR 1992 3:35 pm
;;3.0; Surgery ;;24 Jun 93
S Y=SRDATE D D^DIQ S SRDT=Y
W !!,"Automatically matching Risk Assessment entries with Surgery Cases"
K ^TMP("CONVERT") S ^TMP("CONVERT","MATCH",1)="The following assessments were matched with entries in the SURGERY file (130)",^TMP("CONVERT","MATCH",2)="based on the patient identifier and date of operation."
S ^TMP("CONVERT","MATCH",3)=" ",SRCNT=3
S SRAN=0 F S SRAN=$O(^SRA(SRAN)) Q:'SRAN S SRA(0)=^SRA(SRAN,0),DFN=$P(SRA(0),"^"),SRSDATE=$E($P(SRA(0),"^",5),1,7) D CHECK I OK D CONVERT,DELETE
I $D(^TMP("CONVERT","MATCH",4)) D SENDMSG
I '$O(^SRA(0)) Q
S (CNT,X)=0 F S X=$O(^SRA(X)) Q:'X S CNT=CNT+1
MANUAL W !!,"There "_$S(CNT=1:"is ",1:"are ")_CNT_" assessment"_$S(CNT=1:"",1:"s")_" remaining."
W !!,"Do you want to continue with the manual matching process now ? YES// " R SRYN:DTIME I '$T!(SRYN["^") S SRSOUT=1 Q
S SRYN=$E(SRYN) I "YyNn"'[SRYN D HELP Q:SRSOUT G MANUAL
I "Yy"'[SRYN S SRSOUT=1 Q
S SRAN=0 F S SRAN=$O(^SRA(SRAN)) Q:'SRAN!(SRSOUT) S OK=0 D ^SROASWP3 I OK D CONVERT,DELETE
Q
CONVERT S SRDD=8 F S SRDD=$O(^DD(139,SRDD)) Q:'SRDD D MOVE
S SRCD=$P(^SRA(SRAN,0),"^",9)
S A=^SRA(SRAN,"S"),SRSTATUS=$P(A,"^"),SRTYPE=$P(A,"^",2) K A S DR="284////"_SRTYPE_";Q;235////"_SRSTATUS_";272////"_SRCD_";323////Y",DA=SRTN,DIE=130 D ^DIE
D ^SROCCAT
K SRDD,X,Y,Z
D MSGLINE
Q
MOVE ; move data from file 139 to file 130
I SRDD=11!(SRDD=12)!(SRDD=17)!(SRDD=23)!(SRDD=24)!(SRDD=44)!(SRDD=78)!(SRDD=136) Q
I SRDD=95!(SRDD=153)!(SRDD=185)!(SRDD=182)!(SRDD=192)!(SRDD=219)!(SRDD=216) Q
I SRDD=289!(SRDD=290)!(SRDD=291)!(SRDD=292)!(SRDD=293)!(SRDD=294) Q
I SRDD=295!(SRDD=75)!(SRDD=125)!(SRDD=99)!(SRDD=80)!(SRDD=74)!(SRDD=149) Q
S GLOBAL=$P(^DD(139,SRDD,0),"^",4),P1=$P(GLOBAL,";"),P2=$P(GLOBAL,";",2),DATA=$P($G(^SRA(SRAN,P1)),"^",P2)
S ^TMP("CONVERT",SRAN,SRTN)="MATCHED"
I SRDD=216 S SRFIELD=$P($G(^SRA(SRAN,2)),"^",22) I SRFIELD'="" S DA=SRTN,DIE=130,DR=".25////"_SRFIELD D ^DIE K DA,DR,DIE Q
S X=$P(^DD(139,SRDD,0),"^"),SRFIELD=$O(^DD(130,"B",X,0)) ; I SRFIELD W !!,SRDD_" ",X,?45,SRFIELD,?50,DATA
S GLOBAL=$P(^DD(130,SRFIELD,0),"^",4),P1=$P(GLOBAL,";"),P2=$P(GLOBAL,";",2),$P(^SRF(SRTN,P1),"^",P2)=DATA
Q
CHECK ; check for match
K CASE S (OK,SRTN,CNT)=0 F S SRTN=$O(^SRF("B",DFN,SRTN)) Q:'SRTN S DATE=$E($P(^SRF(SRTN,0),"^",9),1,7) I DATE=SRSDATE S CNT=CNT+1,CASE(CNT)=SRTN
K SRTN I '$D(CASE(1)) Q
I $D(CASE(2)) Q
S OK=1,SRTN=CASE(1) W "."
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","MATCH",SRCNT)=SRANAME_" DATE OF OPERATION: "_DATE,SRCNT=SRCNT+1,^TMP("CONVERT","MATCH",SRCNT)="SURGERY CASE NUMBER: "_SRTN,SRCNT=SRCNT+1,^TMP("CONVERT","MATCH",SRCNT)=" "
Q
SENDMSG ; send mail message
S XMY("G.RISK ASSESSMENT@"_^XMB("NETNAME"))=""
S XMSUB="SURGERY RISK ASSESSMENT ENTRIES AUTOMATICALLY CONVERTED",XMDUZ="RISK ASSESSMENT CONVERSION",XMTEXT="^TMP(""CONVERT"",""MATCH"","
N I D ^XMD K XMSUB,XMDUZ,XMTEXT,XMY
Q
HELP W !!,"Enter 'YES' if you want to continue converting assessments manually, or 'NO'",!,"to quit this option.",!
K DIR S DIR(0)="E" D ^DIR I 'Y S SRSOUT=1
Q
SROASWP2 ;B'HAM ISC/MAM - MOVE RISK TO FILE 130 ; 13 APR 1992 3:35 pm
+1 ;;3.0; Surgery ;;24 Jun 93
+2 SET Y=SRDATE
DO D^DIQ
SET SRDT=Y
+3 WRITE !!,"Automatically matching Risk Assessment entries with Surgery Cases"
+4 KILL ^TMP("CONVERT")
SET ^TMP("CONVERT","MATCH",1)="The following assessments were matched with entries in the SURGERY file (130)"
SET ^TMP("CONVERT","MATCH",2)="based on the patient identifier and date of operation."
+5 SET ^TMP("CONVERT","MATCH",3)=" "
SET SRCNT=3
+6 SET SRAN=0
FOR
SET SRAN=$ORDER(^SRA(SRAN))
IF 'SRAN
QUIT
SET SRA(0)=^SRA(SRAN,0)
SET DFN=$PIECE(SRA(0),"^")
SET SRSDATE=$EXTRACT($PIECE(SRA(0),"^",5),1,7)
DO CHECK
IF OK
DO CONVERT
DO DELETE
+7 IF $DATA(^TMP("CONVERT","MATCH",4))
DO SENDMSG
+8 IF '$ORDER(^SRA(0))
QUIT
+9 SET (CNT,X)=0
FOR
SET X=$ORDER(^SRA(X))
IF 'X
QUIT
SET CNT=CNT+1
MANUAL WRITE !!,"There "_$SELECT(CNT=1:"is ",1:"are ")_CNT_" assessment"_$SELECT(CNT=1:"",1:"s")_" remaining."
+1 WRITE !!,"Do you want to continue with the manual matching process now ? YES// "
READ SRYN:DTIME
IF '$TEST!(SRYN["^")
SET SRSOUT=1
QUIT
+2 SET SRYN=$EXTRACT(SRYN)
IF "YyNn"'[SRYN
DO HELP
IF SRSOUT
QUIT
GOTO MANUAL
+3 IF "Yy"'[SRYN
SET SRSOUT=1
QUIT
+4 SET SRAN=0
FOR
SET SRAN=$ORDER(^SRA(SRAN))
IF 'SRAN!(SRSOUT)
QUIT
SET OK=0
DO ^SROASWP3
IF OK
DO CONVERT
DO DELETE
+5 QUIT
CONVERT SET SRDD=8
FOR
SET SRDD=$ORDER(^DD(139,SRDD))
IF 'SRDD
QUIT
DO MOVE
+1 SET SRCD=$PIECE(^SRA(SRAN,0),"^",9)
+2 SET A=^SRA(SRAN,"S")
SET SRSTATUS=$PIECE(A,"^")
SET SRTYPE=$PIECE(A,"^",2)
KILL A
SET DR="284////"_SRTYPE_";Q;235////"_SRSTATUS_";272////"_SRCD_";323////Y"
SET DA=SRTN
SET DIE=130
DO ^DIE
+3 DO ^SROCCAT
+4 KILL SRDD,X,Y,Z
+5 DO MSGLINE
+6 QUIT
MOVE ; move data from file 139 to file 130
+1 IF SRDD=11!(SRDD=12)!(SRDD=17)!(SRDD=23)!(SRDD=24)!(SRDD=44)!(SRDD=78)!(SRDD=136)
QUIT
+2 IF SRDD=95!(SRDD=153)!(SRDD=185)!(SRDD=182)!(SRDD=192)!(SRDD=219)!(SRDD=216)
QUIT
+3 IF SRDD=289!(SRDD=290)!(SRDD=291)!(SRDD=292)!(SRDD=293)!(SRDD=294)
QUIT
+4 IF SRDD=295!(SRDD=75)!(SRDD=125)!(SRDD=99)!(SRDD=80)!(SRDD=74)!(SRDD=149)
QUIT
+5 SET GLOBAL=$PIECE(^DD(139,SRDD,0),"^",4)
SET P1=$PIECE(GLOBAL,";")
SET P2=$PIECE(GLOBAL,";",2)
SET DATA=$PIECE($GET(^SRA(SRAN,P1)),"^",P2)
+6 SET ^TMP("CONVERT",SRAN,SRTN)="MATCHED"
+7 IF SRDD=216
SET SRFIELD=$PIECE($GET(^SRA(SRAN,2)),"^",22)
IF SRFIELD'=""
SET DA=SRTN
SET DIE=130
SET DR=".25////"_SRFIELD
DO ^DIE
KILL DA,DR,DIE
QUIT
+8 ; I SRFIELD W !!,SRDD_" ",X,?45,SRFIELD,?50,DATA
SET X=$PIECE(^DD(139,SRDD,0),"^")
SET SRFIELD=$ORDER(^DD(130,"B",X,0))
+9 SET GLOBAL=$PIECE(^DD(130,SRFIELD,0),"^",4)
SET P1=$PIECE(GLOBAL,";")
SET P2=$PIECE(GLOBAL,";",2)
SET $PIECE(^SRF(SRTN,P1),"^",P2)=DATA
+10 QUIT
CHECK ; check for match
+1 KILL CASE
SET (OK,SRTN,CNT)=0
FOR
SET SRTN=$ORDER(^SRF("B",DFN,SRTN))
IF 'SRTN
QUIT
SET DATE=$EXTRACT($PIECE(^SRF(SRTN,0),"^",9),1,7)
IF DATE=SRSDATE
SET CNT=CNT+1
SET CASE(CNT)=SRTN
+2 KILL SRTN
IF '$DATA(CASE(1))
QUIT
+3 IF $DATA(CASE(2))
QUIT
+4 SET OK=1
SET SRTN=CASE(1)
WRITE "."
+5 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","MATCH",SRCNT)=SRANAME_" DATE OF OPERATION: "_DATE
SET SRCNT=SRCNT+1
SET ^TMP("CONVERT","MATCH",SRCNT)="SURGERY CASE NUMBER: "_SRTN
SET SRCNT=SRCNT+1
SET ^TMP("CONVERT","MATCH",SRCNT)=" "
+3 QUIT
SENDMSG ; send mail message
+1 SET XMY("G.RISK ASSESSMENT@"_^XMB("NETNAME"))=""
+2 SET XMSUB="SURGERY RISK ASSESSMENT ENTRIES AUTOMATICALLY CONVERTED"
SET XMDUZ="RISK ASSESSMENT CONVERSION"
SET XMTEXT="^TMP(""CONVERT"",""MATCH"","
+3 NEW I
DO ^XMD
KILL XMSUB,XMDUZ,XMTEXT,XMY
+4 QUIT
HELP WRITE !!,"Enter 'YES' if you want to continue converting assessments manually, or 'NO'",!,"to quit this option.",!
+1 KILL DIR
SET DIR(0)="E"
DO ^DIR
IF 'Y
SET SRSOUT=1
+2 QUIT
