- PSALOG0 ;BIR/LTL,JMB-Unposted Procurement History - CONT'D ;7/23/97
- ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;; 10/24/97
- ;This routine prints the Unposted Pharmacy Procurement report. It is
- ;called from PSALOG.
- ;
- POS S (PSAPG,PSAOUT)=0,$P(PSASLN,"-",81)="",$P(PSADLN,"=",81)=""
- S PSARPDT=$E($$HTFM^XLFDT($H),1,12),PSADT=$P(PSARPDT,".")
- S PSARPDT=$E(PSADT,4,5)_"/"_$E(PSADT,6,7)_"/"_$E(PSADT,2,3)_"@"_$P(PSARPDT,".",2)
- D HDR G:PSAOUT END
- RT F S PSAYRMO=$O(^PRC(442,"AB",PSAYRMO)) Q:'PSAYRMO!($E(PSAYRMO,4,5)'=PSAMO) S PSAIEN="" D
- .F S PSAIEN=+$O(^PRC(442,"AB",PSAYRMO,PSAIEN)) Q:'PSAIEN I $P($G(^PRC(442,PSAIEN,0)),"^",5)=822400,$P($G(^PRC(442,PSAIEN,7)),"^")>14&($P($G(^(7)),"^")<45) D
- ..S ^TMP("PSAB",$J,$E($P($G(^PRC(442,PSAIEN,0)),"^"),1,3)_$E($P($G(^PRC(442,PSAIEN,0)),"^",3),1,4),PSAIEN)=""
- RTD I '$D(^TMP("PSAB",$J)) W !!,"No items were found for the selected month." G END
- S PSACP=""
- F S PSACP=$O(^TMP("PSAB",$J,PSACP)) Q:PSACP="" D:$Y+4>IOSL HDR G:PSAOUT END W !!,"STATION/CP: ",PSACP S PSAIEN=0 F S PSAIEN=+$O(^TMP("PSAB",$J,PSACP,PSAIEN)) Q:'PSAIEN D:$Y+4>IOSL HDR G:PSAOUT END D
- .S PSAN0=$G(^PRC(442,PSAIEN,0))
- .W !,$E($P(PSAN0,"^"),5,10)
- .S PSAN1=$G(^PRC(442,PSAIEN,1)),PSADT=$P(PSAN1,"^",15)
- .S Y=PSADT X ^DD("DD") W ?10,Y
- .W ?22,$E($P(PSAN0,"^",3),1,3),?27,$E($$VENNAME^PRCPUX1($P(PSAN1,"^")_"PRC(440"),1,30)
- .S X=$P(PSAN0,"^",15),PSATOT=$G(PSATOT)+X,X2="2$",X3=10 D COMMA^%DTC
- .W ?69,X
- .Q:'$D(^PRC(442,PSAIEN,2,0)) S PSAITEM=0
- .F S PSAITEM=+$O(^PRC(442,PSAIEN,2,PSAITEM)) Q:'PSAITEM D
- ..S:$G(^PRC(442,PSAIEN,2,PSAITEM,1,1,0))]"" ^TMP("PSA",$J,PSACP,$E($G(^PRC(442,PSAIEN,2,PSAITEM,1,1,0)),1,65),PSAIEN)=$G(^PRC(442,PSAIEN,2,PSAITEM,0))
- .I $G(PSATOT),'$O(^TMP("PSAB",$J,PSACP,PSAIEN)) S X=PSATOT,X2="2$",X3=10 D COMMA^%DTC S PSACOST=X D Q:PSAOUT
- ..D:$Y+5>IOSL HDR Q:PSAOUT
- ..W !,PSADLN,!,?57,"TOTAL COST: ",PSACOST K PSATOT
- END W:$E(IOST)'="C" @IOF
- I $E(IOST,1,2)="C-",'$G(PSAOUT) D
- .S PSASS=22-$Y F PSAKK=1:1:PSASS W !
- .S DIR(0)="EA",DIR("A")="END OF REPORT! Press <RET> to return to continue." D ^DIR K DIR S:'Y PSAOUT=1
- Q
- HDR I $E(IOST,1,2)="C-",PSAPG D Q:PSAOUT
- .S PSASS=22-$Y F PSAKK=1:1:PSASS W !
- .S DIR(0)="E" D ^DIR K DIR S:'Y PSAOUT=1
- I $$S^%ZTLOAD S PSAOUT=1 Q
- W:$Y @IOF S PSAPG=PSAPG+1
- W:$E(IOST)'="C" !!,PSARPDT W:$E(IOST,1,2)="C-" !
- W ?20,"DRUG ACCOUNTABILITY/INVENTORY INTERFACE",?72,"PAGE ",$J(PSAPG,2)
- W !?19,"UNPOSTED PHARMACY PROCUREMENTS FOR ",PSAMOYR
- W !!,"PO #",?10,"PO DATE",?22,"CP",?27,"VENDOR",?69,"TOTAL COST",!,PSADLN
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSALOG0 2561 printed Feb 18, 2025@23:15:59 Page 2
- PSALOG0 ;BIR/LTL,JMB-Unposted Procurement History - CONT'D ;7/23/97
- +1 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;; 10/24/97
- +2 ;This routine prints the Unposted Pharmacy Procurement report. It is
- +3 ;called from PSALOG.
- +4 ;
- POS SET (PSAPG,PSAOUT)=0
- SET $PIECE(PSASLN,"-",81)=""
- SET $PIECE(PSADLN,"=",81)=""
- +1 SET PSARPDT=$EXTRACT($$HTFM^XLFDT($HOROLOG),1,12)
- SET PSADT=$PIECE(PSARPDT,".")
- +2 SET PSARPDT=$EXTRACT(PSADT,4,5)_"/"_$EXTRACT(PSADT,6,7)_"/"_$EXTRACT(PSADT,2,3)_"@"_$PIECE(PSARPDT,".",2)
- +3 DO HDR
- if PSAOUT
- GOTO END
- RT FOR
- SET PSAYRMO=$ORDER(^PRC(442,"AB",PSAYRMO))
- if 'PSAYRMO!($EXTRACT(PSAYRMO,4,5)'=PSAMO)
- QUIT
- SET PSAIEN=""
- Begin DoDot:1
- +1 FOR
- SET PSAIEN=+$ORDER(^PRC(442,"AB",PSAYRMO,PSAIEN))
- if 'PSAIEN
- QUIT
- IF $PIECE($GET(^PRC(442,PSAIEN,0)),"^",5)=822400
- IF $PIECE($GET(^PRC(442,PSAIEN,7)),"^")>14&($PIECE($GET(^(7)),"^")<45)
- Begin DoDot:2
- +2 SET ^TMP("PSAB",$JOB,$EXTRACT($PIECE($GET(^PRC(442,PSAIEN,0)),"^"),1,3)_$EXTRACT($PIECE($GET(^PRC(442,PSAIEN,0)),"^",3),1,4),PSAIEN)=""
- End DoDot:2
- End DoDot:1
- RTD IF '$DATA(^TMP("PSAB",$JOB))
- WRITE !!,"No items were found for the selected month."
- GOTO END
- +1 SET PSACP=""
- +2 FOR
- SET PSACP=$ORDER(^TMP("PSAB",$JOB,PSACP))
- if PSACP=""
- QUIT
- if $Y+4>IOSL
- DO HDR
- if PSAOUT
- GOTO END
- WRITE !!,"STATION/CP: ",PSACP
- SET PSAIEN=0
- FOR
- SET PSAIEN=+$ORDER(^TMP("PSAB",$JOB,PSACP,PSAIEN))
- if 'PSAIEN
- QUIT
- if $Y+4>IOSL
- DO HDR
- if PSAOUT
- GOTO END
- Begin DoDot:1
- +3 SET PSAN0=$GET(^PRC(442,PSAIEN,0))
- +4 WRITE !,$EXTRACT($PIECE(PSAN0,"^"),5,10)
- +5 SET PSAN1=$GET(^PRC(442,PSAIEN,1))
- SET PSADT=$PIECE(PSAN1,"^",15)
- +6 SET Y=PSADT
- XECUTE ^DD("DD")
- WRITE ?10,Y
- +7 WRITE ?22,$EXTRACT($PIECE(PSAN0,"^",3),1,3),?27,$EXTRACT($$VENNAME^PRCPUX1($PIECE(PSAN1,"^")_"PRC(440"),1,30)
- +8 SET X=$PIECE(PSAN0,"^",15)
- SET PSATOT=$GET(PSATOT)+X
- SET X2="2$"
- SET X3=10
- DO COMMA^%DTC
- +9 WRITE ?69,X
- +10 if '$DATA(^PRC(442,PSAIEN,2,0))
- QUIT
- SET PSAITEM=0
- +11 FOR
- SET PSAITEM=+$ORDER(^PRC(442,PSAIEN,2,PSAITEM))
- if 'PSAITEM
- QUIT
- Begin DoDot:2
- +12 if $GET(^PRC(442,PSAIEN,2,PSAITEM,1,1,0))]""
- SET ^TMP("PSA",$JOB,PSACP,$EXTRACT($GET(^PRC(442,PSAIEN,2,PSAITEM,1,1,0)),1,65),PSAIEN)=$GET(^PRC(442,PSAIEN,2,PSAITEM,0))
- End DoDot:2
- +13 IF $GET(PSATOT)
- IF '$ORDER(^TMP("PSAB",$JOB,PSACP,PSAIEN))
- SET X=PSATOT
- SET X2="2$"
- SET X3=10
- DO COMMA^%DTC
- SET PSACOST=X
- Begin DoDot:2
- +14 if $Y+5>IOSL
- DO HDR
- if PSAOUT
- QUIT
- +15 WRITE !,PSADLN,!,?57,"TOTAL COST: ",PSACOST
- KILL PSATOT
- End DoDot:2
- if PSAOUT
- QUIT
- End DoDot:1
- END if $EXTRACT(IOST)'="C"
- WRITE @IOF
- +1 IF $EXTRACT(IOST,1,2)="C-"
- IF '$GET(PSAOUT)
- Begin DoDot:1
- +2 SET PSASS=22-$Y
- FOR PSAKK=1:1:PSASS
- WRITE !
- +3 SET DIR(0)="EA"
- SET DIR("A")="END OF REPORT! Press <RET> to return to continue."
- DO ^DIR
- KILL DIR
- if 'Y
- SET PSAOUT=1
- End DoDot:1
- +4 QUIT
- HDR IF $EXTRACT(IOST,1,2)="C-"
- IF PSAPG
- Begin DoDot:1
- +1 SET PSASS=22-$Y
- FOR PSAKK=1:1:PSASS
- WRITE !
- +2 SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- if 'Y
- SET PSAOUT=1
- End DoDot:1
- if PSAOUT
- QUIT
- +3 IF $$S^%ZTLOAD
- SET PSAOUT=1
- QUIT
- +4 if $Y
- WRITE @IOF
- SET PSAPG=PSAPG+1
- +5 if $EXTRACT(IOST)'="C"
- WRITE !!,PSARPDT
- if $EXTRACT(IOST,1,2)="C-"
- WRITE !
- +6 WRITE ?20,"DRUG ACCOUNTABILITY/INVENTORY INTERFACE",?72,"PAGE ",$JUSTIFY(PSAPG,2)
- +7 WRITE !?19,"UNPOSTED PHARMACY PROCUREMENTS FOR ",PSAMOYR
- +8 WRITE !!,"PO #",?10,"PO DATE",?22,"CP",?27,"VENDOR",?69,"TOTAL COST",!,PSADLN
- +9 QUIT