- 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
