- PSXCMOP ;BIR/WRT-review NDF (LOOP) matches for CMOP ;[ 07/20/98 1:45 PM ]
- ;;2.0;CMOP;**18,23**;11 Apr 97
- ;Reference to ^PSDRUG( Supported by DBIA #1983, #2367
- START D ^PSXCMOP0
- Q
- MARK 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
- Q:PSXFL
- I "^"[X S PSXFL=1 Q:PSXFL=1 G DONE^PSXCMOP0
- I "Yy"[X S ^TMP($J,"PSXANS",PSXDA)="YES^"_PSXDU D DU^PSXCMOP1,QUES2
- Q
- DOIT 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
- I $P(^TMP($J,"PSXANS",WAS),"^",1)="NO" S ^PSDRUG(WAS,3)=0,DA=WAS D ^PSXREF K DA S PSXF=1
- D IT
- Q
- DOIT1 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
- I $P(^TMP($J,"PSXANS",WAS),"^",3)="NO" D SYN^PSXCMOP0
- Q
- IT K ^TMP($J,"PSXANS",WAS)
- Q
- QUES2 S PSXDUP=0
- 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
- Q:PSXFL
- I "Yy"[X D DUP I PSXDUP=0 S $P(^TMP($J,"PSXANS",PSXDA),"^",3)="YES",$P(^TMP($J,"PSXANS",PSXDA),"^",4)=PSXM
- I "^"[X S PSXFL=1 Q:PSXFL G DONE^PSXCMOP0
- Q
- DUP I PSXM'=PSXLOC,$D(^PSDRUG("B",PSXM)) S PSXDUP=1
- F DA=0:0 S DA=$O(^TMP($J,"PSXANS",DA)) Q:'DA I $P(^TMP($J,"PSXANS",DA),"^",3)="YES" S PSXDUP=1
- D:PSXDUP=1 MESS S:PSXDUP=1 $P(^TMP($J,"PSXANS",PSXDA),"^",3)="NO"
- Q
- MESS 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
- Q
- BLD1 I $P($G(^PSDRUG(PSXB,0)),"^",3)[1!$P($G(^PSDRUG(PSXB,0)),"^",3)[2 Q
- S PSXDN=^PSDRUG(PSXB,"ND"),PSXGN=$P(PSXDN,"^",1),PSXVP=$P(PSXDN,"^",3)
- 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
- Q
- TMP S ^TMP($J,"PSXCMOP",PSXVAP,PSXB)=PSXDP
- Q
- PICK1 S PSXM="" F S PSXM=$O(^TMP($J,"PSXCMOP",PSXM)) Q:PSXM="" Q:PSXFL D PICK2 Q:PSXEND
- Q
- PICK2 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
- Q
- GOTIT S PSXZERO=^PSDRUG(PSXDA,0),PSXLOC=$P(PSXZERO,"^",1),PSXDU=$P(^TMP($J,"PSXCMOP",PSXM,PSXDA),"^",1) D DISPLAY^PSXCMOP0 Q:PSXF Q:PSXFL
- Q
- GROUP I $D(^TMP($J,"PSXANS")) D GROUP1
- Q
- GROUP1 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.?",!
- F RRF=1:1:80 W "-"
- 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
- D ASK
- Q
- ASK 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.",!
- W !,"Are you sure everything is correct? " K DIR S DIR(0)="Y" D ^DIR D OUT I "Nn"[X G PICK1
- 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
- I "^"[X S PSXFL=1 Q:PSXFL G DONE^PSXCMOP0
- Q
- OUT I $D(DTOUT),DTOUT=1 S PSXFL=1,PSXBT=1
- Q
- PSXCMOP ;BIR/WRT-review NDF (LOOP) matches for CMOP ;[ 07/20/98 1:45 PM ]
- +1 ;;2.0;CMOP;**18,23**;11 Apr 97
- +2 ;Reference to ^PSDRUG( Supported by DBIA #1983, #2367
- START DO ^PSXCMOP0
- +1 QUIT
- MARK WRITE !!,"Do you wish to mark this drug to transmit to CMOP? "
- KILL DIR
- SET DIR(0)="Y"
- DO ^DIR
- DO OUT
- IF "Nn"[X
- SET ^TMP($JOB,"PSXANS",PSXDA)="NO"
- IF '$ORDER(^TMP($JOB,"PSXCMOP",PSXM,PSXDA))
- DO GROUP
- SET PSXF=1
- IF PSXF=1
- QUIT
- IF PSXFL=1
- QUIT
- +1 IF PSXFL
- QUIT
- +2 IF "^"[X
- SET PSXFL=1
- IF PSXFL=1
- QUIT
- GOTO DONE^PSXCMOP0
- +3 IF "Yy"[X
- SET ^TMP($JOB,"PSXANS",PSXDA)="YES^"_PSXDU
- DO DU^PSXCMOP1
- DO QUES2
- +4 QUIT
- DOIT IF $PIECE(^TMP($JOB,"PSXANS",WAS),"^",1)="YES"
- SET PSXLM=$PIECE(^PSDRUG(WAS,0),"^",1)
- SET $PIECE(^PSDRUG(WAS,660),"^",8)=$PIECE(^TMP($JOB,"PSXANS",WAS),"^",2)
- SET ^PSDRUG(WAS,3)=1
- SET ^PSDRUG("AQ",WAS)=""
- DO DOIT1
- DO PR^PSXCMOP1
- SET DA=WAS
- DO ^PSXREF
- DO IDENT^PSXCMOP1
- KILL DA
- SET PSXF=1
- +1 IF $PIECE(^TMP($JOB,"PSXANS",WAS),"^",1)="NO"
- SET ^PSDRUG(WAS,3)=0
- SET DA=WAS
- DO ^PSXREF
- KILL DA
- SET PSXF=1
- +2 DO IT
- +3 QUIT
- DOIT1 IF $PIECE(^TMP($JOB,"PSXANS",WAS),"^",3)="YES"
- SET $PIECE(^PSDRUG(WAS,0),"^",1)=PSXM
- SET ^PSDRUG("B",PSXM,WAS)=""
- IF PSXM'=PSXLM
- KILL ^PSDRUG("B",PSXLM,WAS)
- DO TRAN^PSXCMOP1
- +1 IF $PIECE(^TMP($JOB,"PSXANS",WAS),"^",3)="NO"
- DO SYN^PSXCMOP0
- +2 QUIT
- IT KILL ^TMP($JOB,"PSXANS",WAS)
- +1 QUIT
- QUES2 SET PSXDUP=0
- +1 WRITE !!,"Do you wish to overwrite your local name? "
- KILL DIR
- SET DIR(0)="Y"
- SET DIR("?")="If you answer ""yes"", you will overwrite GENERIC NAME with the VA Print Name."
- DO ^DIR
- DO OUT
- IF "Nn"[X
- SET $PIECE(^TMP($JOB,"PSXANS",PSXDA),"^",3)="NO"
- SET PSXG=1
- IF PSXG=1
- QUIT
- +2 IF PSXFL
- QUIT
- +3 IF "Yy"[X
- DO DUP
- IF PSXDUP=0
- SET $PIECE(^TMP($JOB,"PSXANS",PSXDA),"^",3)="YES"
- SET $PIECE(^TMP($JOB,"PSXANS",PSXDA),"^",4)=PSXM
- +4 IF "^"[X
- SET PSXFL=1
- IF PSXFL
- QUIT
- GOTO DONE^PSXCMOP0
- +5 QUIT
- DUP IF PSXM'=PSXLOC
- IF $DATA(^PSDRUG("B",PSXM))
- SET PSXDUP=1
- +1 FOR DA=0:0
- SET DA=$ORDER(^TMP($JOB,"PSXANS",DA))
- IF 'DA
- QUIT
- IF $PIECE(^TMP($JOB,"PSXANS",DA),"^",3)="YES"
- SET PSXDUP=1
- +2 IF PSXDUP=1
- DO MESS
- IF PSXDUP=1
- SET $PIECE(^TMP($JOB,"PSXANS",PSXDA),"^",3)="NO"
- +3 QUIT
- MESS WRITE !!,"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.",!
- HANG 4
- +1 QUIT
- BLD1 IF $PIECE($GET(^PSDRUG(PSXB,0)),"^",3)[1!$PIECE($GET(^PSDRUG(PSXB,0)),"^",3)[2
- QUIT
- +1 SET PSXDN=^PSDRUG(PSXB,"ND")
- SET PSXGN=$PIECE(PSXDN,"^",1)
- SET PSXVP=$PIECE(PSXDN,"^",3)
- +2 SET ZX=$$PROD2^PSNAPIS(PSXGN,PSXVP)
- IF $PIECE($GET(ZX),"^",3)=1
- SET PSXCMOP=$PIECE(ZX,"^",2)
- SET PSXVAP=$PIECE(ZX,"^")
- SET PSXDP=$PIECE(ZX,"^",4)
- KILL ZX
- DO TMP
- +3 QUIT
- TMP SET ^TMP($JOB,"PSXCMOP",PSXVAP,PSXB)=PSXDP
- +1 QUIT
- PICK1 SET PSXM=""
- FOR
- SET PSXM=$ORDER(^TMP($JOB,"PSXCMOP",PSXM))
- IF PSXM=""
- QUIT
- IF PSXFL
- QUIT
- DO PICK2
- IF PSXEND
- QUIT
- +1 QUIT
- PICK2 FOR PSXDA=0:0
- SET PSXDA=$ORDER(^TMP($JOB,"PSXCMOP",PSXM,PSXDA))
- IF 'PSXDA
- QUIT
- DO GOTIT
- IF '$ORDER(^TMP($JOB,"PSXCMOP",PSXM,PSXDA))
- IF PSXFL=1
- QUIT
- DO GROUP
- IF PSXF=1
- QUIT
- +1 QUIT
- GOTIT SET PSXZERO=^PSDRUG(PSXDA,0)
- SET PSXLOC=$PIECE(PSXZERO,"^",1)
- SET PSXDU=$PIECE(^TMP($JOB,"PSXCMOP",PSXM,PSXDA),"^",1)
- DO DISPLAY^PSXCMOP0
- IF PSXF
- QUIT
- IF PSXFL
- QUIT
- +1 QUIT
- GROUP IF $DATA(^TMP($JOB,"PSXANS"))
- DO GROUP1
- +1 QUIT
- GROUP1 IF PSXFL
- QUIT
- WRITE @IOF
- SET NUM=0
- WRITE !?5,"VA Print Name: ",PSXM,!!,?3,"Local Drug Name",?46,"CMOP?",?55,"VA D.U.",?70,"O.W.?",!
- +1 FOR RRF=1:1:80
- WRITE "-"
- +2 FOR NDA=0:0
- SET NDA=$ORDER(^TMP($JOB,"PSXANS",NDA))
- IF 'NDA
- QUIT
- SET NUM=NUM+1
- WRITE !,NUM_".",?3,$PIECE(^PSDRUG(NDA,0),"^",1),?46,$PIECE(^TMP($JOB,"PSXANS",NDA),"^",1),?55,$PIECE(^TMP($JOB,"PSXANS",NDA),"^",2),?70,$PIECE(^TMP($JOB,"PSXANS",NDA),"^",3)
- DO PRC^PSXCMOP1
- +3 DO ASK
- +4 QUIT
- ASK WRITE !!!,"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.",!
- +1 WRITE !,"Are you sure everything is correct? "
- KILL DIR
- SET DIR(0)="Y"
- DO ^DIR
- DO OUT
- IF "Nn"[X
- GOTO PICK1
- +2 IF "Yy"[X
- FOR WAS=0:0
- SET WAS=$ORDER(^TMP($JOB,"PSXANS",WAS))
- IF 'WAS
- QUIT
- DO DOIT
- KILL ^TMP($JOB,"PSXCMOP",PSXM)
- IF '$DATA(^TMP($JOB,"PSXCMOP"))
- SET PSXEND=1
- +3 IF "^"[X
- SET PSXFL=1
- IF PSXFL
- QUIT
- GOTO DONE^PSXCMOP0
- +4 QUIT
- OUT IF $DATA(DTOUT)
- IF DTOUT=1
- SET PSXFL=1
- SET PSXBT=1
- +1 QUIT
