- PSACON ;BIR/LTL-Display Connected Drug and Procurement History ;7/23/97
- ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**15**; 10/24/97
- ;References to $$DESCR^PRCPUX1 are covered by IA #259
- ;References to ^DIC(51.5 are covered by IA #1931
- ;References to $$NSN^PRCPUX1 are covered by IA #259
- ;References to $$UNITCODE^PRCPUX1 are covered by IA #259
- ;References to $$UNITVAL^PRCPUX1 are covered by IA #259
- ;References to $$VENNAME^PRCPUX1 are covered by IA #259
- ;References to ^PSDRUG( are covered by IA #2095
- ;References to ^PRC( are covered by IA #214
- ;References to ^PRCP( are covered by IA #214
- ;
- N DA,DIC,DTOUT,DUOUT,PSA,PSACON,PSAW,X,Y
- D DT^DICRW
- F S DIC="^PSDRUG(",DIC(0)="AEMQZ",DIC("S")="I $S('$D(^(""I"")):1,+^(""I"")>DT:1,1:0)",DIC("W")="W:'$O(^(441,0)) ?65,""NOT CONNECTED""" W ! D ^DIC K DA,DIC G:Y<0 END S PSA=+Y D G:Y<0 END G:$G(PSAW) ^PSACONW D:$G(PSACON) ^PSACON1 D ^PSACON2
- .W @IOF,!!,$P($G(^PSDRUG(+PSA,0)),U),!!,?25,"** FROM THE DRUG FILE **",!!
- .W "FSN: ",$P($G(^PSDRUG(+PSA,0)),U,6),?40,"NDC: ",$P($G(^PSDRUG(+PSA,2)),U,4),!!
- .S PSA(5)=$S($P($G(^PSDRUG(+PSA,660)),U,5):$P($G(^(660)),U,5),1:1)
- .S PSA(6)=$P($G(^DIC(51.5,+$P($G(^PSDRUG(+PSA,660)),U,2),0)),U)
- .W "PACKAGING: ",PSA(5),"/",PSA(6)
- .S PSA(8)=$P($G(^PSDRUG(+PSA,660)),U,8)
- .W ?20,"PRICE: $",$P($G(^PSDRUG(+PSA,660)),U,3),"/",PSA(6)
- .W ?40,"PRICE/DISPENSE UNIT: $",$P($G(^PSDRUG(+PSA,660)),U,6),"/",PSA(8)
- .S PSA(15)=$O(^PSDRUG(+PSA,441,0)),PSA(1)=$G(^(+PSA(15),0))
- .;more than one item linked
- .D:$O(^PSDRUG(+PSA,441,PSA(15))) Q:Y<0 K DIC,DA
- ..W !!,"There is more than one item linked to this drug.",!
- ..S DIC="^PSDRUG(+PSA,441,",DIC(0)="AEQ",DA(1)=+PSA
- ..S DIC("W")="W ?10,$$DESCR^PRCPUX1(0,$G(^(0)))"
- ..D ^DIC Q:Y<0 S PSA(1)=$G(^PSDRUG(+PSA,441,+Y,0)) K DIC,DA
- .I 'PSA(1) S Y=-1 Q
- .D:PSA(1) Q:$D(DTOUT)!($D(DUOUT))
- ..W !!?25,"<< FROM THE ITEM MASTER FILE >>",!!
- ..S PSA(11)=$G(^PRC(441,+PSA(1),0))
- ..W "ITEM #: ",PSA(1),?15,$$DESCR^PRCPUX1(0,PSA(1)),!!
- ..W "NSN: ",$$NSN^PRCPUX1(PSA(1))
- ..I $P($G(^PRC(440,+$P(PSA(11),U,8),0)),U,11)="S" S PSAW=$O(^PRCP(445,"AC","W","")) Q
- ..S PSA(3)=$O(^PRC(441,+PSA(1),2,0))
- ..I PSA(3)&('$O(^PRC(441,+PSA(1),2,+PSA(3)))) D Q
- ...W ?40,"ONLY VENDOR: ",$E($$VENNAME^PRCPUX1(+PSA(3)_"PRC(440"),1,28),!!
- ...S PSA(33)=$G(^PRC(441,+PSA(1),2,+PSA(3),0))
- ...W "VENDOR STOCK #: ",$P(PSA(33),U,4)
- ...W ?40,"NDC: ",$P(PSA(33),U,5),!!
- ...W "PACKAGING: ",$$UNITVAL^PRCPUX1($P(PSA(33),U,8),$P(PSA(33),U,7))
- ...W ?20,"PRICE: $",$P(PSA(33),U,2),"/",$$UNITCODE^PRCPUX1($P(PSA(33),U,7))
- ...W ?40,"PRICE/DISPENSE UNIT: $",$P(PSA(33),U,2)/PSA(5)
- ...W !!,"MINIMUM ORDER: ",$P(PSA(33),U,12)
- ...S Y=$P(PSA(33),U,6) X ^DD("DD")
- ...S Y=$E(Y,1,4)_$S($L(Y)=10:$E(Y,7,10),$L(Y)=11:$E(Y,8,11),1:"")
- ...W ?20,"PRICE DATE: ",Y
- ...W ?40,"REQUIRED ORDER MULTIPLE: ",$P(PSA(33),U,11),!!
- ..W !!,"LAST VENDOR ORDERED: ",$$VENNAME^PRCPUX1($P(PSA(11),U,4)_"PRC(440"),!!
- ..W "MANDATORY SOURCE: ",$$VENNAME^PRCPUX1($P(PSA(11),U,8)_"PRC(440"),!
- ..K IO("Q") N %ZIS,IOP,POP S %ZIS="Q",%ZIS("A")="For Vendor listing, please select DEVICE: " D ^%ZIS I POP S DTOUT=1,Y=-1 W !,"NO DEVICE SELECTED OR OUTPUT PRINTED!" Q
- ..I $D(IO("Q")) N ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTDTH,ZTSK S ZTRTN="^PSACON1",ZTDESC="DRUG VENDORS",ZTSAVE("PSA*")="" D ^%ZTLOAD,HOME^%ZIS S Y=1 Q
- ..S (DTOUT,PSACON)=1 Q
- END K PSAOUT Q
- PSACON ;BIR/LTL-Display Connected Drug and Procurement History ;7/23/97
- +1 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**15**; 10/24/97
- +2 ;References to $$DESCR^PRCPUX1 are covered by IA #259
- +3 ;References to ^DIC(51.5 are covered by IA #1931
- +4 ;References to $$NSN^PRCPUX1 are covered by IA #259
- +5 ;References to $$UNITCODE^PRCPUX1 are covered by IA #259
- +6 ;References to $$UNITVAL^PRCPUX1 are covered by IA #259
- +7 ;References to $$VENNAME^PRCPUX1 are covered by IA #259
- +8 ;References to ^PSDRUG( are covered by IA #2095
- +9 ;References to ^PRC( are covered by IA #214
- +10 ;References to ^PRCP( are covered by IA #214
- +11 ;
- +12 NEW DA,DIC,DTOUT,DUOUT,PSA,PSACON,PSAW,X,Y
- +13 DO DT^DICRW
- +14 FOR
- SET DIC="^PSDRUG("
- SET DIC(0)="AEMQZ"
- SET DIC("S")="I $S('$D(^(""I"")):1,+^(""I"")>DT:1,1:0)"
- SET DIC("W")="W:'$O(^(441,0)) ?65,""NOT CONNECTED"""
- WRITE !
- DO ^DIC
- KILL DA,DIC
- IF Y<0
- GOTO END
- SET PSA=+Y
- Begin DoDot:1
- +15 WRITE @IOF,!!,$PIECE($GET(^PSDRUG(+PSA,0)),U),!!,?25,"** FROM THE DRUG FILE **",!!
- +16 WRITE "FSN: ",$PIECE($GET(^PSDRUG(+PSA,0)),U,6),?40,"NDC: ",$PIECE($GET(^PSDRUG(+PSA,2)),U,4),!!
- +17 SET PSA(5)=$SELECT($PIECE($GET(^PSDRUG(+PSA,660)),U,5):$PIECE($GET(^(660)),U,5),1:1)
- +18 SET PSA(6)=$PIECE($GET(^DIC(51.5,+$PIECE($GET(^PSDRUG(+PSA,660)),U,2),0)),U)
- +19 WRITE "PACKAGING: ",PSA(5),"/",PSA(6)
- +20 SET PSA(8)=$PIECE($GET(^PSDRUG(+PSA,660)),U,8)
- +21 WRITE ?20,"PRICE: $",$PIECE($GET(^PSDRUG(+PSA,660)),U,3),"/",PSA(6)
- +22 WRITE ?40,"PRICE/DISPENSE UNIT: $",$PIECE($GET(^PSDRUG(+PSA,660)),U,6),"/",PSA(8)
- +23 SET PSA(15)=$ORDER(^PSDRUG(+PSA,441,0))
- SET PSA(1)=$GET(^(+PSA(15),0))
- +24 ;more than one item linked
- +25 IF $ORDER(^PSDRUG(+PSA,441,PSA(15)))
- Begin DoDot:2
- +26 WRITE !!,"There is more than one item linked to this drug.",!
- +27 SET DIC="^PSDRUG(+PSA,441,"
- SET DIC(0)="AEQ"
- SET DA(1)=+PSA
- +28 SET DIC("W")="W ?10,$$DESCR^PRCPUX1(0,$G(^(0)))"
- +29 DO ^DIC
- IF Y<0
- QUIT
- SET PSA(1)=$GET(^PSDRUG(+PSA,441,+Y,0))
- KILL DIC,DA
- End DoDot:2
- IF Y<0
- QUIT
- KILL DIC,DA
- +30 IF 'PSA(1)
- SET Y=-1
- QUIT
- +31 IF PSA(1)
- Begin DoDot:2
- +32 WRITE !!?25,"<< FROM THE ITEM MASTER FILE >>",!!
- +33 SET PSA(11)=$GET(^PRC(441,+PSA(1),0))
- +34 WRITE "ITEM #: ",PSA(1),?15,$$DESCR^PRCPUX1(0,PSA(1)),!!
- +35 WRITE "NSN: ",$$NSN^PRCPUX1(PSA(1))
- +36 IF $PIECE($GET(^PRC(440,+$PIECE(PSA(11),U,8),0)),U,11)="S"
- SET PSAW=$ORDER(^PRCP(445,"AC","W",""))
- QUIT
- +37 SET PSA(3)=$ORDER(^PRC(441,+PSA(1),2,0))
- +38 IF PSA(3)&('$ORDER(^PRC(441,+PSA(1),2,+PSA(3))))
- Begin DoDot:3
- +39 WRITE ?40,"ONLY VENDOR: ",$EXTRACT($$VENNAME^PRCPUX1(+PSA(3)_"PRC(440"),1,28),!!
- +40 SET PSA(33)=$GET(^PRC(441,+PSA(1),2,+PSA(3),0))
- +41 WRITE "VENDOR STOCK #: ",$PIECE(PSA(33),U,4)
- +42 WRITE ?40,"NDC: ",$PIECE(PSA(33),U,5),!!
- +43 WRITE "PACKAGING: ",$$UNITVAL^PRCPUX1($PIECE(PSA(33),U,8),$PIECE(PSA(33),U,7))
- +44 WRITE ?20,"PRICE: $",$PIECE(PSA(33),U,2),"/",$$UNITCODE^PRCPUX1($PIECE(PSA(33),U,7))
- +45 WRITE ?40,"PRICE/DISPENSE UNIT: $",$PIECE(PSA(33),U,2)/PSA(5)
- +46 WRITE !!,"MINIMUM ORDER: ",$PIECE(PSA(33),U,12)
- +47 SET Y=$PIECE(PSA(33),U,6)
- XECUTE ^DD("DD")
- +48 SET Y=$EXTRACT(Y,1,4)_$SELECT($LENGTH(Y)=10:$EXTRACT(Y,7,10),$LENGTH(Y)=11:$EXTRACT(Y,8,11),1:"")
- +49 WRITE ?20,"PRICE DATE: ",Y
- +50 WRITE ?40,"REQUIRED ORDER MULTIPLE: ",$PIECE(PSA(33),U,11),!!
- End DoDot:3
- QUIT
- +51 WRITE !!,"LAST VENDOR ORDERED: ",$$VENNAME^PRCPUX1($PIECE(PSA(11),U,4)_"PRC(440"),!!
- +52 WRITE "MANDATORY SOURCE: ",$$VENNAME^PRCPUX1($PIECE(PSA(11),U,8)_"PRC(440"),!
- +53 KILL IO("Q")
- NEW %ZIS,IOP,POP
- SET %ZIS="Q"
- SET %ZIS("A")="For Vendor listing, please select DEVICE: "
- DO ^%ZIS
- IF POP
- SET DTOUT=1
- SET Y=-1
- WRITE !,"NO DEVICE SELECTED OR OUTPUT PRINTED!"
- QUIT
- +54 IF $DATA(IO("Q"))
- NEW ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTDTH,ZTSK
- SET ZTRTN="^PSACON1"
- SET ZTDESC="DRUG VENDORS"
- SET ZTSAVE("PSA*")=""
- DO ^%ZTLOAD
- DO HOME^%ZIS
- SET Y=1
- QUIT
- +55 SET (DTOUT,PSACON)=1
- QUIT
- End DoDot:2
- IF $DATA(DTOUT)!($DATA(DUOUT))
- QUIT
- End DoDot:1
- IF Y<0
- GOTO END
- IF $GET(PSAW)
- GOTO ^PSACONW
- IF $GET(PSACON)
- DO ^PSACON1
- DO ^PSACON2
- END KILL PSAOUT
- QUIT
