source: FOIAVistA/trunk/r/SURGERY-SR/SROASWP2.m@ 1470

Last change on this file since 1470 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.3 KB
Line 
1SROASWP2 ;B'HAM ISC/MAM - MOVE RISK TO FILE 130 ; 13 APR 1992 3:35 pm
2 ;;3.0; Surgery ;;24 Jun 93
3 S Y=SRDATE D D^DIQ S SRDT=Y
4 W !!,"Automatically matching Risk Assessment entries with Surgery Cases"
5 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."
6 S ^TMP("CONVERT","MATCH",3)=" ",SRCNT=3
7 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
8 I $D(^TMP("CONVERT","MATCH",4)) D SENDMSG
9 I '$O(^SRA(0)) Q
10 S (CNT,X)=0 F S X=$O(^SRA(X)) Q:'X S CNT=CNT+1
11MANUAL W !!,"There "_$S(CNT=1:"is ",1:"are ")_CNT_" assessment"_$S(CNT=1:"",1:"s")_" remaining."
12 W !!,"Do you want to continue with the manual matching process now ? YES// " R SRYN:DTIME I '$T!(SRYN["^") S SRSOUT=1 Q
13 S SRYN=$E(SRYN) I "YyNn"'[SRYN D HELP Q:SRSOUT G MANUAL
14 I "Yy"'[SRYN S SRSOUT=1 Q
15 S SRAN=0 F S SRAN=$O(^SRA(SRAN)) Q:'SRAN!(SRSOUT) S OK=0 D ^SROASWP3 I OK D CONVERT,DELETE
16 Q
17CONVERT S SRDD=8 F S SRDD=$O(^DD(139,SRDD)) Q:'SRDD D MOVE
18 S SRCD=$P(^SRA(SRAN,0),"^",9)
19 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
20 D ^SROCCAT
21 K SRDD,X,Y,Z
22 D MSGLINE
23 Q
24MOVE ; move data from file 139 to file 130
25 I SRDD=11!(SRDD=12)!(SRDD=17)!(SRDD=23)!(SRDD=24)!(SRDD=44)!(SRDD=78)!(SRDD=136) Q
26 I SRDD=95!(SRDD=153)!(SRDD=185)!(SRDD=182)!(SRDD=192)!(SRDD=219)!(SRDD=216) Q
27 I SRDD=289!(SRDD=290)!(SRDD=291)!(SRDD=292)!(SRDD=293)!(SRDD=294) Q
28 I SRDD=295!(SRDD=75)!(SRDD=125)!(SRDD=99)!(SRDD=80)!(SRDD=74)!(SRDD=149) Q
29 S GLOBAL=$P(^DD(139,SRDD,0),"^",4),P1=$P(GLOBAL,";"),P2=$P(GLOBAL,";",2),DATA=$P($G(^SRA(SRAN,P1)),"^",P2)
30 S ^TMP("CONVERT",SRAN,SRTN)="MATCHED"
31 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
32 S X=$P(^DD(139,SRDD,0),"^"),SRFIELD=$O(^DD(130,"B",X,0)) ; I SRFIELD W !!,SRDD_" ",X,?45,SRFIELD,?50,DATA
33 S GLOBAL=$P(^DD(130,SRFIELD,0),"^",4),P1=$P(GLOBAL,";"),P2=$P(GLOBAL,";",2),$P(^SRF(SRTN,P1),"^",P2)=DATA
34 Q
35CHECK ; check for match
36 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
37 K SRTN I '$D(CASE(1)) Q
38 I $D(CASE(2)) Q
39 S OK=1,SRTN=CASE(1) W "."
40 Q
41DELETE ; delete assessment from 139
42 S DA=SRAN,DIK="^SRA(" D ^DIK Q
43 Q
44MSGLINE ; store info for mail message
45 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)
46 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)=" "
47 Q
48SENDMSG ; send mail message
49 S XMY("G.RISK ASSESSMENT@"_^XMB("NETNAME"))=""
50 S XMSUB="SURGERY RISK ASSESSMENT ENTRIES AUTOMATICALLY CONVERTED",XMDUZ="RISK ASSESSMENT CONVERSION",XMTEXT="^TMP(""CONVERT"",""MATCH"","
51 N I D ^XMD K XMSUB,XMDUZ,XMTEXT,XMY
52 Q
53HELP W !!,"Enter 'YES' if you want to continue converting assessments manually, or 'NO'",!,"to quit this option.",!
54 K DIR S DIR(0)="E" D ^DIR I 'Y S SRSOUT=1
55 Q
Note: See TracBrowser for help on using the repository browser.