- PSAORDP2 ;BIR/JMB-Print Orders - CONT'D ;7/23/97
- ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;; 10/24/97
- ;This routine prints the adjustment and header data on the invoices.
- ;It is called from PSAORDP1
- ;
- ADJD ;Print Adj Drug
- I $G(PSADJD)'="" D Q:PSAOUT
- .I ($G(PSADJDV)'=""&($Y+5>IOSL))!(($G(PSADJDP)'=""&($Y+4>IOSL))) D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT D HEADER,LINEHDR
- .I $G(PSADJDV)'="" W !?9,$$DATE^PSAORDP1(PSADVDT)_" "_$P($G(^VA(200,+PSADVDUZ,0)),"^")_" (V)"
- .I $G(PSADJDP)'="" W !?9,$$DATE^PSAORDP1(PSADPDT)_" "_$P($G(^VA(200,+PSADPDUZ,0)),"^")_" (P)"
- ;
- ADJQ ;Print Adj Qty
- I $G(PSADJQ)'="" D Q:PSAOUT
- .I ($G(PSADJQV)'=""&($Y+8>IOSL))!(($G(PSADJQP)'=""&($Y+6>IOSL))) D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT D HEADER,LINEHDR
- .W !!?9,"ADJUSTED QUANTITY: "_PSADJQ
- .I $G(PSADJQV)'="" W !?9,$$DATE^PSAORDP1(PSAQVDT)_" "_$P($G(^VA(200,+PSAQVDUZ,0)),"^")_" (V) = "_PSADJQV,!?11,PSAQVREA
- .I $G(PSADJQP)'="" W !?9,$$DATE^PSAORDP1(PSAQPDT)_" "_$P($G(^VA(200,+PSAQPDUZ,0)),"^")_" (P) = "_PSADJQP,!?11,PSAQPREA
- ;
- ADJO ;Print Adj Order Unit
- I $G(PSADJO)'="" D Q:PSAOUT
- .I ($G(PSADJOV)'=""&($Y+6>IOSL))!(($G(PSADJOP)'=""&($Y+4>IOSL))) D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT D HEADER,LINEHDR
- .W !!,?9,"ADJUSTED ORDER UNIT: "_$P($G(^DIC(51.5,+PSADJO,0)),"^")
- .I $G(PSADJOV)'="" W !?9,$$DATE^PSAORDP1(PSAOVDT)_" "_$P($G(^VA(200,+PSAOVDUZ,0)),"^")_" (V) = "_$P($G(^DIC(51.5,+PSADJOV,0)),"^")
- .I $G(PSADJOP)'="" W !?9,$$DATE^PSAORDP1(PSAOPDT)_" "_$P($G(^VA(200,+PSAOPDUZ,0)),"^")_" (P) = "_$P($G(^DIC(51.5,+PSADJOP,0)),"^")
- ;
- ADJP ;Print Adj Price
- I +$G(PSADJP) D Q:PSAOUT
- .I ($G(PSADJPV)'=""&($Y+6>IOSL))!(($G(PSADJPP)'=""&($Y+4>IOSL))) D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT D HEADER,LINEHDR
- .W !!,?9,"ADJUSTED PRICE PER ORDER UNIT: $"_$S($L($P(PSADJP,".",2))<2:$FN(PSADJP,",",2),1:PSADJP)
- .I $G(PSADJPV)'="" W !?9,$$DATE^PSAORDP1(PSAPVDT)_" "_$P($G(^VA(200,+PSAPVDUZ,0)),"^")_" (V) = $"_$S($L($P(PSADJPV,".",2))<2:$FN(PSADJPV,",",2),1:PSADJPV)
- .I $G(PSADJPP)'="" W !?9,$$DATE^PSAORDP1(PSAPPDT)_" "_$P($G(^VA(200,+PSAPPDUZ,0)),"^")_" (P) = $"_$S($L($P(PSADJPP,".",2))<2:$FN(PSADJPP,",",2),1:PSADJPP)
- Q
- ;
- LINEHDR ;item header
- W !?50,"ORDER",?62,"COST/",?71,"EXTENDED"
- W !,"LINE#",?9,"NDC",?25,"VSN",?43,"QTY",?51,"UNIT",?62,"UNIT",?75,"COST",!,PSADLN,!
- Q
- ;
- I PSAFPG&($E(IOST,1,2)="C-") W @IOF G HDR1
- S PSAFPG=0
- I 'PSAFPG W @IOF
- HDR1 W !?20,"DRUG ACCOUNTABILITY/INVENTORY INTERFACE"
- W !?27,"PRIME VENDOR ORDER REPORT",!
- W:PSAPAGE'=1 !,"ORDER#: "_PSAORDER_" INVOICE#: "_PSAINVN
- I $E(IOST,1,2)="C-" W ?(74-$L(PSAPAGE)),"PAGE "_PSAPAGE,!,PSADLN
- I $E(IOST)'="C" W !,"RUN: "_PSARUN,?(74-$L(PSAPAGE)),"PAGE "_PSAPAGE,!,PSADLN
- S PSAPAGE=PSAPAGE+1
- Q
- SCREEN ;Hold on screen
- S PSAS=20-$Y I +PSAS F PSASS=1:1:PSAS W !
- I PSADJDRG,PSAEND W " * THE DRUG WAS MATCHED TO THE DRUG FILE."
- I PSADJSUP,PSAEND W !,"** THE ITEM IS A SUPPLY ITEM."
- S DIR(0)="E" D ^DIR K DIR I $G(DIRUT) S PSAOUT=1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSAORDP2 2986 printed Feb 18, 2025@23:16:18 Page 2
- PSAORDP2 ;BIR/JMB-Print Orders - CONT'D ;7/23/97
- +1 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;; 10/24/97
- +2 ;This routine prints the adjustment and header data on the invoices.
- +3 ;It is called from PSAORDP1
- +4 ;
- ADJD ;Print Adj Drug
- +1 IF $GET(PSADJD)'=""
- Begin DoDot:1
- +2 IF ($GET(PSADJDV)'=""&($Y+5>IOSL))!(($GET(PSADJDP)'=""&($Y+4>IOSL)))
- if $EXTRACT(IOST,1,2)="C-"
- DO SCREEN
- if PSAOUT
- QUIT
- DO HEADER
- DO LINEHDR
- +3 IF $GET(PSADJDV)'=""
- WRITE !?9,$$DATE^PSAORDP1(PSADVDT)_" "_$PIECE($GET(^VA(200,+PSADVDUZ,0)),"^")_" (V)"
- +4 IF $GET(PSADJDP)'=""
- WRITE !?9,$$DATE^PSAORDP1(PSADPDT)_" "_$PIECE($GET(^VA(200,+PSADPDUZ,0)),"^")_" (P)"
- End DoDot:1
- if PSAOUT
- QUIT
- +5 ;
- ADJQ ;Print Adj Qty
- +1 IF $GET(PSADJQ)'=""
- Begin DoDot:1
- +2 IF ($GET(PSADJQV)'=""&($Y+8>IOSL))!(($GET(PSADJQP)'=""&($Y+6>IOSL)))
- if $EXTRACT(IOST,1,2)="C-"
- DO SCREEN
- if PSAOUT
- QUIT
- DO HEADER
- DO LINEHDR
- +3 WRITE !!?9,"ADJUSTED QUANTITY: "_PSADJQ
- +4 IF $GET(PSADJQV)'=""
- WRITE !?9,$$DATE^PSAORDP1(PSAQVDT)_" "_$PIECE($GET(^VA(200,+PSAQVDUZ,0)),"^")_" (V) = "_PSADJQV,!?11,PSAQVREA
- +5 IF $GET(PSADJQP)'=""
- WRITE !?9,$$DATE^PSAORDP1(PSAQPDT)_" "_$PIECE($GET(^VA(200,+PSAQPDUZ,0)),"^")_" (P) = "_PSADJQP,!?11,PSAQPREA
- End DoDot:1
- if PSAOUT
- QUIT
- +6 ;
- ADJO ;Print Adj Order Unit
- +1 IF $GET(PSADJO)'=""
- Begin DoDot:1
- +2 IF ($GET(PSADJOV)'=""&($Y+6>IOSL))!(($GET(PSADJOP)'=""&($Y+4>IOSL)))
- if $EXTRACT(IOST,1,2)="C-"
- DO SCREEN
- if PSAOUT
- QUIT
- DO HEADER
- DO LINEHDR
- +3 WRITE !!,?9,"ADJUSTED ORDER UNIT: "_$PIECE($GET(^DIC(51.5,+PSADJO,0)),"^")
- +4 IF $GET(PSADJOV)'=""
- WRITE !?9,$$DATE^PSAORDP1(PSAOVDT)_" "_$PIECE($GET(^VA(200,+PSAOVDUZ,0)),"^")_" (V) = "_$PIECE($GET(^DIC(51.5,+PSADJOV,0)),"^")
- +5 IF $GET(PSADJOP)'=""
- WRITE !?9,$$DATE^PSAORDP1(PSAOPDT)_" "_$PIECE($GET(^VA(200,+PSAOPDUZ,0)),"^")_" (P) = "_$PIECE($GET(^DIC(51.5,+PSADJOP,0)),"^")
- End DoDot:1
- if PSAOUT
- QUIT
- +6 ;
- ADJP ;Print Adj Price
- +1 IF +$GET(PSADJP)
- Begin DoDot:1
- +2 IF ($GET(PSADJPV)'=""&($Y+6>IOSL))!(($GET(PSADJPP)'=""&($Y+4>IOSL)))
- if $EXTRACT(IOST,1,2)="C-"
- DO SCREEN
- if PSAOUT
- QUIT
- DO HEADER
- DO LINEHDR
- +3 WRITE !!,?9,"ADJUSTED PRICE PER ORDER UNIT: $"_$SELECT($LENGTH($PIECE(PSADJP,".",2))<2:$FNUMBER(PSADJP,",",2),1:PSADJP)
- +4 IF $GET(PSADJPV)'=""
- WRITE !?9,$$DATE^PSAORDP1(PSAPVDT)_" "_$PIECE($GET(^VA(200,+PSAPVDUZ,0)),"^")_" (V) = $"_$SELECT($LENGTH($PIECE(PSADJPV,".",2))<2:$FNUMBER(PSADJPV,",",2),1:PSADJPV)
- +5 IF $GET(PSADJPP)'=""
- WRITE !?9,$$DATE^PSAORDP1(PSAPPDT)_" "_$PIECE($GET(^VA(200,+PSAPPDUZ,0)),"^")_" (P) = $"_$SELECT($LENGTH($PIECE(PSADJPP,".",2))<2:$FNUMBER(PSADJPP,",",2),1:PSADJPP)
- End DoDot:1
- if PSAOUT
- QUIT
- +6 QUIT
- +7 ;
- LINEHDR ;item header
- +1 WRITE !?50,"ORDER",?62,"COST/",?71,"EXTENDED"
- +2 WRITE !,"LINE#",?9,"NDC",?25,"VSN",?43,"QTY",?51,"UNIT",?62,"UNIT",?75,"COST",!,PSADLN,!
- +3 QUIT
- +4 ;
- +1 IF PSAFPG&($EXTRACT(IOST,1,2)="C-")
- WRITE @IOF
- GOTO HDR1
- +2 SET PSAFPG=0
- +3 IF 'PSAFPG
- WRITE @IOF
- HDR1 WRITE !?20,"DRUG ACCOUNTABILITY/INVENTORY INTERFACE"
- +1 WRITE !?27,"PRIME VENDOR ORDER REPORT",!
- +2 if PSAPAGE'=1
- WRITE !,"ORDER#: "_PSAORDER_" INVOICE#: "_PSAINVN
- +3 IF $EXTRACT(IOST,1,2)="C-"
- WRITE ?(74-$LENGTH(PSAPAGE)),"PAGE "_PSAPAGE,!,PSADLN
- +4 IF $EXTRACT(IOST)'="C"
- WRITE !,"RUN: "_PSARUN,?(74-$LENGTH(PSAPAGE)),"PAGE "_PSAPAGE,!,PSADLN
- +5 SET PSAPAGE=PSAPAGE+1
- +6 QUIT
- SCREEN ;Hold on screen
- +1 SET PSAS=20-$Y
- IF +PSAS
- FOR PSASS=1:1:PSAS
- WRITE !
- +2 IF PSADJDRG
- IF PSAEND
- WRITE " * THE DRUG WAS MATCHED TO THE DRUG FILE."
- +3 IF PSADJSUP
- IF PSAEND
- WRITE !,"** THE ITEM IS A SUPPLY ITEM."
- +4 SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- IF $GET(DIRUT)
- SET PSAOUT=1
- +5 QUIT