source: WorldVistAEHR/trunk/r/CMOP-PSX/PSXCMOP.m@ 975

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

initial load of WorldVistAEHR

File size: 3.5 KB
Line 
1PSXCMOP ;BIR/WRT-review NDF (LOOP) matches for CMOP ;[ 07/20/98 1:45 PM ]
2 ;;2.0;CMOP;**18,23**;11 Apr 97
3 ;Reference to ^PSDRUG( Supported by DBIA #1983, #2367
4START D ^PSXCMOP0
5 Q
6MARK W !!,"Do you wish to mark this drug to transmit to CMOP? " K DIR S DIR(0)="Y" D ^DIR D OUT I "Nn"[X S ^TMP($J,"PSXANS",PSXDA)="NO" I '$O(^TMP($J,"PSXCMOP",PSXM,PSXDA)) D GROUP S PSXF=1 Q:PSXF=1 Q:PSXFL=1
7 Q:PSXFL
8 I "^"[X S PSXFL=1 Q:PSXFL=1 G DONE^PSXCMOP0
9 I "Yy"[X S ^TMP($J,"PSXANS",PSXDA)="YES^"_PSXDU D DU^PSXCMOP1,QUES2
10 Q
11DOIT I $P(^TMP($J,"PSXANS",WAS),"^",1)="YES" S PSXLM=$P(^PSDRUG(WAS,0),"^",1),$P(^PSDRUG(WAS,660),"^",8)=$P(^TMP($J,"PSXANS",WAS),"^",2),^PSDRUG(WAS,3)=1,^PSDRUG("AQ",WAS)="" D DOIT1,PR^PSXCMOP1 S DA=WAS D ^PSXREF,IDENT^PSXCMOP1 K DA S PSXF=1
12 I $P(^TMP($J,"PSXANS",WAS),"^",1)="NO" S ^PSDRUG(WAS,3)=0,DA=WAS D ^PSXREF K DA S PSXF=1
13 D IT
14 Q
15DOIT1 I $P(^TMP($J,"PSXANS",WAS),"^",3)="YES" S $P(^PSDRUG(WAS,0),"^",1)=PSXM,^PSDRUG("B",PSXM,WAS)="" K:PSXM'=PSXLM ^PSDRUG("B",PSXLM,WAS) D TRAN^PSXCMOP1
16 I $P(^TMP($J,"PSXANS",WAS),"^",3)="NO" D SYN^PSXCMOP0
17 Q
18IT K ^TMP($J,"PSXANS",WAS)
19 Q
20QUES2 S PSXDUP=0
21 W !!,"Do you wish to overwrite your local name? " K DIR S DIR(0)="Y",DIR("?")="If you answer ""yes"", you will overwrite GENERIC NAME with the VA Print Name." D ^DIR D OUT I "Nn"[X S $P(^TMP($J,"PSXANS",PSXDA),"^",3)="NO" S PSXG=1 Q:PSXG=1
22 Q:PSXFL
23 I "Yy"[X D DUP I PSXDUP=0 S $P(^TMP($J,"PSXANS",PSXDA),"^",3)="YES",$P(^TMP($J,"PSXANS",PSXDA),"^",4)=PSXM
24 I "^"[X S PSXFL=1 Q:PSXFL G DONE^PSXCMOP0
25 Q
26DUP I PSXM'=PSXLOC,$D(^PSDRUG("B",PSXM)) S PSXDUP=1
27 F DA=0:0 S DA=$O(^TMP($J,"PSXANS",DA)) Q:'DA I $P(^TMP($J,"PSXANS",DA),"^",3)="YES" S PSXDUP=1
28 D:PSXDUP=1 MESS S:PSXDUP=1 $P(^TMP($J,"PSXANS",PSXDA),"^",3)="NO"
29 Q
30MESS W !!,"You cannot write over the GENERIC NAME because you have either",!,"already marked one to overwrite or have already overwritten one",!,"with that VA Print Name. You cannot have duplicate names.",! H 4
31 Q
32BLD1 I $P($G(^PSDRUG(PSXB,0)),"^",3)[1!$P($G(^PSDRUG(PSXB,0)),"^",3)[2 Q
33 S PSXDN=^PSDRUG(PSXB,"ND"),PSXGN=$P(PSXDN,"^",1),PSXVP=$P(PSXDN,"^",3)
34 S ZX=$$PROD2^PSNAPIS(PSXGN,PSXVP) I $P($G(ZX),"^",3)=1 S PSXCMOP=$P(ZX,"^",2),PSXVAP=$P(ZX,"^"),PSXDP=$P(ZX,"^",4) K ZX D TMP
35 Q
36TMP S ^TMP($J,"PSXCMOP",PSXVAP,PSXB)=PSXDP
37 Q
38PICK1 S PSXM="" F S PSXM=$O(^TMP($J,"PSXCMOP",PSXM)) Q:PSXM="" Q:PSXFL D PICK2 Q:PSXEND
39 Q
40PICK2 F PSXDA=0:0 S PSXDA=$O(^TMP($J,"PSXCMOP",PSXM,PSXDA)) Q:'PSXDA D GOTIT I '$O(^TMP($J,"PSXCMOP",PSXM,PSXDA)) Q:PSXFL=1 D GROUP Q:PSXF=1
41 Q
42GOTIT S PSXZERO=^PSDRUG(PSXDA,0),PSXLOC=$P(PSXZERO,"^",1),PSXDU=$P(^TMP($J,"PSXCMOP",PSXM,PSXDA),"^",1) D DISPLAY^PSXCMOP0 Q:PSXF Q:PSXFL
43 Q
44GROUP I $D(^TMP($J,"PSXANS")) D GROUP1
45 Q
46GROUP1 Q:PSXFL W @IOF S NUM=0 W !?5,"VA Print Name: ",PSXM,!!,?3,"Local Drug Name",?46,"CMOP?",?55,"VA D.U.",?70,"O.W.?",!
47 F RRF=1:1:80 W "-"
48 F NDA=0:0 S NDA=$O(^TMP($J,"PSXANS",NDA)) Q:'NDA S NUM=NUM+1 W !,NUM_".",?3,$P(^PSDRUG(NDA,0),"^",1),?46,$P(^TMP($J,"PSXANS",NDA),"^",1),?55,$P(^TMP($J,"PSXANS",NDA),"^",2),?70,$P(^TMP($J,"PSXANS",NDA),"^",3) D PRC^PSXCMOP1
49 D ASK
50 Q
51ASK W !!!,"If you answer ""Yes"" you will go to the next VA Print Name. If you answer ""No""",!,"you will go back through this particular VA Print Name group.",!
52 W !,"Are you sure everything is correct? " K DIR S DIR(0)="Y" D ^DIR D OUT I "Nn"[X G PICK1
53 I "Yy"[X F WAS=0:0 S WAS=$O(^TMP($J,"PSXANS",WAS)) Q:'WAS D DOIT K ^TMP($J,"PSXCMOP",PSXM) S:'$D(^TMP($J,"PSXCMOP")) PSXEND=1
54 I "^"[X S PSXFL=1 Q:PSXFL G DONE^PSXCMOP0
55 Q
56OUT I $D(DTOUT),DTOUT=1 S PSXFL=1,PSXBT=1
57 Q
Note: See TracBrowser for help on using the repository browser.