- PSXCMOP1 ;BIR/WRT-Complete review NDF (LOOP) matches for CMOP ;[ 10/15/98 10:55 AM ]
- ;;2.0;CMOP;**18,19,23**;11 Apr 97
- ;Reference to ^PSDRUG( supported by DBIA #1983, #2367
- ;Reference to PSNTRAN( supported by DBIA #2527
- COMPLETE I '$D(DUOUT),'$D(DTOUT) W:'$D(^TMP($J,"PSXCMOP")) !!,"You've completed marking everything that is possible.",!! S:'$D(^TMP($J,"PSXCMOP")) PSXFL=1
- Q
- BLD D WR F PSXB=0:0 S PSXB=$O(^PSDRUG(PSXB)) Q:'PSXB D WR1,BLD0,NO
- Q
- BLD0 I PSXNO=0,'$D(^PSDRUG(PSXB,3)),'$D(^PSDRUG(PSXB,"I")),$D(^PSDRUG(PSXB,2)),$P(^PSDRUG(PSXB,2),"^",3)["O",$D(^PSDRUG(PSXB,"ND")),$P(^PSDRUG(PSXB,"ND"),"^",2)]"" D BLD1^PSXCMOP
- Q
- WR W !!,"I have to build a table before you can begin ""looping"" so let me put you on",!,"""hold"" for a moment.",!
- Q
- WR1 U IO(0) W:'(PSXB#100) "."
- Q
- NO1 S PSXNO=0,PSXBT=0
- W !,"Do you wish to loop through the whole file?",!,"(If you answer ""NO"", you will loop through ONLY the ones previously marked as",!,"""Do not transmit to CMOP""). " K DIR S DIR(0)="Y" D ^DIR D OUT1,OUT^PSXCMOP I "Nn"[X S PSXNO=1
- Q:PSXBT
- I "YyNn"[X D BLD
- I "^"[X S PSXBT=1 Q:PSXBT
- Q
- NO I PSXNO=1,$D(^PSDRUG(PSXB,3)),$P(^PSDRUG(PSXB,3),"^",1)=0,'$D(^PSDRUG(PSXB,"I")),$D(^PSDRUG(PSXB,2)),$P(^PSDRUG(PSXB,2),"^",3)["O",$D(^PSDRUG(PSXB,"ND")),$P(^PSDRUG(PSXB,"ND"),"^",2)]"" D BLD1^PSXCMOP
- Q
- TRAN D OLDNM I $D(^PSNTRAN(WAS,"END")) S $P(^PSNTRAN(WAS,"END"),"^",3)=PSXM,$P(^PSNTRAN("END"),"^",3)=PSXM
- Q
- PR I $P(^TMP($J,"PSXANS",WAS),"^",1)="YES",$P(^TMP($J,"PSXANS",WAS),"^",6)]"" S DIE="^PSDRUG(",DA=WAS,DR="13///^S X=PRICE" D ^DIE S DIE="^PSDRUG(",DA=WAS,DR="15///^S X=PSXDUOU" D ^DIE
- Q
- IDENT S PSXNDF=$P(^PSDRUG(WAS,"ND"),"^",1),PSXVAPN=$P(^PSDRUG(WAS,"ND"),"^",3)
- S ZX=$$PROD2^PSNAPIS(PSXNDF,PSXVAPN) I $P($G(ZX),"^",3)']"" W !,"This drug is not marked for CMOP in the National Drug File!" S $P(^PSDRUG(WAS,"ND"),"^",10)="" K ^PSXDRUG("AQ1",PSXIDENT,WAS) Q
- S PSXIDENT=$P(ZX,"^",2),$P(^PSDRUG(WAS,"ND"),"^",10)=PSXIDENT,^PSDRUG("AQ1",PSXIDENT,WAS)="" K ZX
- Q
- OUT1 I $D(DUOUT),DUOUT=1 S PSXFL=1,PSXBT=1 Q
- Q
- DU I $D(^PSDRUG(PSXDA,660)),$P(^PSDRUG(PSXDA,660),"^",8)'=PSXDU W !!,"Your old Dispense Unit ",$P(^PSDRUG(PSXDA,660),"^",8)," does not match the new one ",PSXDU,"." D DU1
- Q
- DU1 W !,"You may wish to edit the Price Per Order Unit and/or the Dispense",!,"Units Per Order Unit.",! D QUEST
- Q
- QUEST W !,"PRICE PER ORDER UNIT: ",$P(^PSDRUG(PSXDA,660),"^",3),"// " R PRICE:DTIME
- I PRICE="^" W !?4,"EXIT NOT ALLOWED ??" K PRICE G QUEST
- S:PRICE']"" PRICE=$P(^PSDRUG(PSXDA,660),"^",3)
- I PRICE]"" S:PRICE["$" PRICE=$P(PRICE,"$",2) I +PRICE'=PRICE&(PRICE'?.N1"."2N)!(PRICE>9999)!(PRICE<0) K PRICE W !,"Type a Dollar Amount between 0 and 9999, 2 Decimal Digits." G QUEST
- S $P(^TMP($J,"PSXANS",PSXDA),"^",6)=PRICE
- QUEST1 W !,"DISPENSE UNITS PER ORDER UNIT: ",$P(^PSDRUG(PSXDA,660),"^",5),"// " R PSXDUOU:DTIME
- I PSXDUOU="^" W !?4,"EXIT NOT ALLOWED ??" K PSXDUOU G QUEST1
- S:PSXDUOU']"" PSXDUOU=$P(^PSDRUG(PSXDA,660),"^",5)
- I PSXDUOU]"" I +PSXDUOU'=PSXDUOU!(PSXDUOU>9999)!(PSXDUOU<1)!(PSXDUOU?.E1"."4N.N) K PSXDUOU W !,"Type a Number between 1 and 9999, 3 Decimal Digits." G QUEST1
- S $P(^TMP($J,"PSXANS",PSXDA),"^",7)=PSXDUOU
- Q
- PRC I $P(^TMP($J,"PSXANS",NDA),"^",6)]"" W !?7,"Price Per Order Unit = ",$P(^TMP($J,"PSXANS",NDA),"^",6),!?7,"Dispense Units Per Order Unit = ",$P(^TMP($J,"PSXANS",NDA),"^",7)
- Q
- OLDNM D OLD I $D(ONCE) D OLD1
- Q
- OLD D NOW^%DTC I $D(^PSDRUG(WAS,900,1,0)) S ONCE=0,PSXLAST=0 F RTC=0:0 S RTC=$O(^PSDRUG(WAS,900,RTC)) Q:'RTC S PSXLAST=PSXLAST+1,PSXNEXT=PSXLAST+1
- I '$D(^PSDRUG(WAS,900,1,0)) S ^PSDRUG(WAS,900,1,0)=PSXLM_"^"_X
- Q
- OLD1 I ONCE=0 S ^PSDRUG(WAS,900,PSXNEXT,0)=PSXLM_"^"_X,ONCE=1
- Q
- PSXCMOP1 ;BIR/WRT-Complete review NDF (LOOP) matches for CMOP ;[ 10/15/98 10:55 AM ]
- +1 ;;2.0;CMOP;**18,19,23**;11 Apr 97
- +2 ;Reference to ^PSDRUG( supported by DBIA #1983, #2367
- +3 ;Reference to PSNTRAN( supported by DBIA #2527
- COMPLETE IF '$DATA(DUOUT)
- IF '$DATA(DTOUT)
- IF '$DATA(^TMP($JOB,"PSXCMOP"))
- WRITE !!,"You've completed marking everything that is possible.",!!
- IF '$DATA(^TMP($JOB,"PSXCMOP"))
- SET PSXFL=1
- +1 QUIT
- BLD DO WR
- FOR PSXB=0:0
- SET PSXB=$ORDER(^PSDRUG(PSXB))
- IF 'PSXB
- QUIT
- DO WR1
- DO BLD0
- DO NO
- +1 QUIT
- BLD0 IF PSXNO=0
- IF '$DATA(^PSDRUG(PSXB,3))
- IF '$DATA(^PSDRUG(PSXB,"I"))
- IF $DATA(^PSDRUG(PSXB,2))
- IF $PIECE(^PSDRUG(PSXB,2),"^",3)["O"
- IF $DATA(^PSDRUG(PSXB,"ND"))
- IF $PIECE(^PSDRUG(PSXB,"ND"),"^",2)]""
- DO BLD1^PSXCMOP
- +1 QUIT
- WR WRITE !!,"I have to build a table before you can begin ""looping"" so let me put you on",!,"""hold"" for a moment.",!
- +1 QUIT
- WR1 USE IO(0)
- IF '(PSXB#100)
- WRITE "."
- +1 QUIT
- NO1 SET PSXNO=0
- SET PSXBT=0
- +1 WRITE !,"Do you wish to loop through the whole file?",!,"(If you answer ""NO"", you will loop through ONLY the ones previously marked as",!,"""Do not transmit to CMOP""). "
- KILL DIR
- SET DIR(0)="Y"
- DO ^DIR
- DO OUT1
- DO OUT^PSXCMOP
- IF "Nn"[X
- SET PSXNO=1
- +2 IF PSXBT
- QUIT
- +3 IF "YyNn"[X
- DO BLD
- +4 IF "^"[X
- SET PSXBT=1
- IF PSXBT
- QUIT
- +5 QUIT
- NO IF PSXNO=1
- IF $DATA(^PSDRUG(PSXB,3))
- IF $PIECE(^PSDRUG(PSXB,3),"^",1)=0
- IF '$DATA(^PSDRUG(PSXB,"I"))
- IF $DATA(^PSDRUG(PSXB,2))
- IF $PIECE(^PSDRUG(PSXB,2),"^",3)["O"
- IF $DATA(^PSDRUG(PSXB,"ND"))
- IF $PIECE(^PSDRUG(PSXB,"ND"),"^",2)]""
- DO BLD1^PSXCMOP
- +1 QUIT
- TRAN DO OLDNM
- IF $DATA(^PSNTRAN(WAS,"END"))
- SET $PIECE(^PSNTRAN(WAS,"END"),"^",3)=PSXM
- SET $PIECE(^PSNTRAN("END"),"^",3)=PSXM
- +1 QUIT
- PR IF $PIECE(^TMP($JOB,"PSXANS",WAS),"^",1)="YES"
- IF $PIECE(^TMP($JOB,"PSXANS",WAS),"^",6)]""
- SET DIE="^PSDRUG("
- SET DA=WAS
- SET DR="13///^S X=PRICE"
- DO ^DIE
- SET DIE="^PSDRUG("
- SET DA=WAS
- SET DR="15///^S X=PSXDUOU"
- DO ^DIE
- +1 QUIT
- IDENT SET PSXNDF=$PIECE(^PSDRUG(WAS,"ND"),"^",1)
- SET PSXVAPN=$PIECE(^PSDRUG(WAS,"ND"),"^",3)
- +1 SET ZX=$$PROD2^PSNAPIS(PSXNDF,PSXVAPN)
- IF $PIECE($GET(ZX),"^",3)']""
- WRITE !,"This drug is not marked for CMOP in the National Drug File!"
- SET $PIECE(^PSDRUG(WAS,"ND"),"^",10)=""
- KILL ^PSXDRUG("AQ1",PSXIDENT,WAS)
- QUIT
- +2 SET PSXIDENT=$PIECE(ZX,"^",2)
- SET $PIECE(^PSDRUG(WAS,"ND"),"^",10)=PSXIDENT
- SET ^PSDRUG("AQ1",PSXIDENT,WAS)=""
- KILL ZX
- +3 QUIT
- OUT1 IF $DATA(DUOUT)
- IF DUOUT=1
- SET PSXFL=1
- SET PSXBT=1
- QUIT
- +1 QUIT
- DU IF $DATA(^PSDRUG(PSXDA,660))
- IF $PIECE(^PSDRUG(PSXDA,660),"^",8)'=PSXDU
- WRITE !!,"Your old Dispense Unit ",$PIECE(^PSDRUG(PSXDA,660),"^",8)," does not match the new one ",PSXDU,"."
- DO DU1
- +1 QUIT
- DU1 WRITE !,"You may wish to edit the Price Per Order Unit and/or the Dispense",!,"Units Per Order Unit.",!
- DO QUEST
- +1 QUIT
- QUEST WRITE !,"PRICE PER ORDER UNIT: ",$PIECE(^PSDRUG(PSXDA,660),"^",3),"// "
- READ PRICE:DTIME
- +1 IF PRICE="^"
- WRITE !?4,"EXIT NOT ALLOWED ??"
- KILL PRICE
- GOTO QUEST
- +2 IF PRICE']""
- SET PRICE=$PIECE(^PSDRUG(PSXDA,660),"^",3)
- +3 IF PRICE]""
- IF PRICE["$"
- SET PRICE=$PIECE(PRICE,"$",2)
- IF +PRICE'=PRICE&(PRICE'?.N1"."2N)!(PRICE>9999)!(PRICE<0)
- KILL PRICE
- WRITE !,"Type a Dollar Amount between 0 and 9999, 2 Decimal Digits."
- GOTO QUEST
- +4 SET $PIECE(^TMP($JOB,"PSXANS",PSXDA),"^",6)=PRICE
- QUEST1 WRITE !,"DISPENSE UNITS PER ORDER UNIT: ",$PIECE(^PSDRUG(PSXDA,660),"^",5),"// "
- READ PSXDUOU:DTIME
- +1 IF PSXDUOU="^"
- WRITE !?4,"EXIT NOT ALLOWED ??"
- KILL PSXDUOU
- GOTO QUEST1
- +2 IF PSXDUOU']""
- SET PSXDUOU=$PIECE(^PSDRUG(PSXDA,660),"^",5)
- +3 IF PSXDUOU]""
- IF +PSXDUOU'=PSXDUOU!(PSXDUOU>9999)!(PSXDUOU<1)!(PSXDUOU?.E1"."4N.N)
- KILL PSXDUOU
- WRITE !,"Type a Number between 1 and 9999, 3 Decimal Digits."
- GOTO QUEST1
- +4 SET $PIECE(^TMP($JOB,"PSXANS",PSXDA),"^",7)=PSXDUOU
- +5 QUIT
- PRC IF $PIECE(^TMP($JOB,"PSXANS",NDA),"^",6)]""
- WRITE !?7,"Price Per Order Unit = ",$PIECE(^TMP($JOB,"PSXANS",NDA),"^",6),!?7,"Dispense Units Per Order Unit = ",$PIECE(^TMP($JOB,"PSXANS",NDA),"^",7)
- +1 QUIT
- OLDNM DO OLD
- IF $DATA(ONCE)
- DO OLD1
- +1 QUIT
- OLD DO NOW^%DTC
- IF $DATA(^PSDRUG(WAS,900,1,0))
- SET ONCE=0
- SET PSXLAST=0
- FOR RTC=0:0
- SET RTC=$ORDER(^PSDRUG(WAS,900,RTC))
- IF 'RTC
- QUIT
- SET PSXLAST=PSXLAST+1
- SET PSXNEXT=PSXLAST+1
- +1 IF '$DATA(^PSDRUG(WAS,900,1,0))
- SET ^PSDRUG(WAS,900,1,0)=PSXLM_"^"_X
- +2 QUIT
- OLD1 IF ONCE=0
- SET ^PSDRUG(WAS,900,PSXNEXT,0)=PSXLM_"^"_X
- SET ONCE=1
- +1 QUIT
