PSOSULOG ;BHAM ISC/RTR-Log of prescriptions on suspense by day ; 11/18/92
;;7.0;OUTPATIENT PHARMACY;**18,264,362,753**;DEC 1997;Build 53
I '$G(PSOSITE) D ^PSOLSET I '$G(PSOSITE) D WARN^PSOSUDCN Q
K ^TMP($J,"PSOSPLOG") N BDATE,EDATE,GG,HDAT,HPAT,PII,LINE,NODE,PAGE,PAT,PATNAME,PATPTR,PDAT,PP,PSOSCMOP,PSOCNT,PSODATE,PSODATEX,PSOINRX,PSORT,PSPRINT,PSUSDIV,QFLAG,SIN,SINRX,X,Y,ZZ
LOG W ! K DIR S DIR("A")="Sort by Patient Name or SSN",DIR(0)="SB^P:PATIENT NAME;S:SOCIAL SECURITY NUMBER",DIR("B")="PATIENT NAME"
S DIR("?")="Enter 'P' to sort by patient name, 'S' to sort by SSN, enter '^' to exit."
D ^DIR K DIR D:$D(DIRUT) MESS G:$D(DIRUT) EXIT S PSORT=Y
DATE W ! K %DT S %DT="AEX",%DT("A")="Start Date: " D ^%DT K %DT G:Y=-1&(X'["^") DATE I X["^"!($D(DTOUT)) D MESS G EXIT
EDATE W ! S BDATE=$E(Y,1,7) S %DT(0)=BDATE,%DT="AEX",%DT("A")="End Date: " D ^%DT K %DT G:Y=-1&(X'["^") EDATE I X["^"!($D(DTOUT)) D MESS G EXIT
S EDATE=$E(Y,1,7) W !
W ! K DIR S DIR(0)="Y",DIR("B")="Y",DIR("A")="Do you want to see only those Rx's that have NOT yet been printed" D ^DIR K DIR D:$D(DIRUT) MESS G:Y["^"!($D(DIRUT)) EXIT S PSPRINT=$S(Y:1,1:0)
S PSOCNT=0 F PII=0:0 S PII=$O(^PS(59,PII)) Q:'PII S PSOCNT=PSOCNT+1
I PSOCNT=1 G SKIP
W !!?3,"You are logged in under the "_$P($G(^PS(59,+$G(PSOSITE),0)),"^")_" division.",!
K DIR S DIR(0)="Y",DIR("B")="Yes",DIR("A")="Print only those Rx's suspended for this division",DIR("?")="Enter 'Yes' to print only those Rx's for this division, enter 'No' to print Rx's suspended for all divisions."
D ^DIR K DIR I Y["^"!($D(DIRUT)) D MESS G EXIT
S PSUSDIV=Y
SKIP ;
I '$G(PSXSYS) G SKIPC
K DIR W ! S DIR(0)="Y",DIR("B")="N",DIR("A")="Do you want suspended CMOP Rx's included in this report" D ^DIR K DIR I Y["^"!($D(DIRUT)) D MESS G EXIT
I $G(Y) S PSOSCMOP=1
SKIPC ;
W ! K DIR S DIR("A")="Do you want this report to print in 80 or 132 column format: ",DIR("B")="132",DIR(0)="SAM^1:132;8:80" D ^DIR K DIR I Y["^"!($D(DIRUT)) D MESS G EXIT
W ! S PSORMZ=$S(Y=1:1,1:0)
K IOP,%ZIS,POP S %ZIS="QM" D ^%ZIS I POP D MESS G EXIT
I $D(IO("Q")) S ZTRTN="REP^PSOSULOG",ZTDESC="Report is suspended Rx's" D G EXIT
.F GG="PSORMZ","PSOSITE","PSOPAR","PSORT","BDATE","EDATE","PSPRINT","PSUSDIV","PSOSCMOP" S:$D(@GG) ZTSAVE(GG)=""
.D ^%ZTLOAD W !,"Task queued to print"
G REP
EXIT ;
K ^TMP($J,"PSOSPLOG") S:$D(ZTQUEUED) ZTREQ="@"
K BDATE,EDATE,GG,HDAT,HPAT,PII,LINE,NODE,PAGE,PAT,PATNAME,PATPTR,PDAT,PP,PSOBAD,PSOSCMOP,PSOCNT,PSODATE,PSODATEX,PSOINRX,PSORMZ,PSORT,PSPRINT,PSUSDIV,QFLAG,SIN,SINRX,X,Y,ZZ
Q
MESS W !!,"No report printed!",!! Q
REP ;
K ^TMP($J,"PSOSPLOG")
U IO S $P(LINE,"-",$S($G(PSORMZ):130,1:79))=""
S BDATE=BDATE-.0001,QFLAG=0,PAGE=1
F ZZ=BDATE:0 S ZZ=$O(^PS(52.5,"C",ZZ)) Q:'ZZ!(ZZ>EDATE) F SIN=0:0 S SIN=$O(^PS(52.5,"C",ZZ,SIN)) Q:'SIN D
.Q:'$P($G(^PS(52.5,SIN,0)),"^",3)
.I $G(PSPRINT),$G(^PS(52.5,SIN,"P")) Q
.I '$G(PSOSCMOP),$P($G(^PS(52.5,SIN,0)),"^",7)'="" Q
.I $G(PSUSDIV),$G(PSOSITE)'=$P($G(^PS(52.5,SIN,0)),"^",6) Q
.S PAT=+$P($G(^PS(52.5,SIN,0)),"^",3) I $P($G(^DPT(PAT,0)),"^")="" Q
.I $P($G(^DPT(PAT,0)),"^",9)="",PSORT="S" Q
.S ^TMP($J,"PSOSPLOG",ZZ,$S(PSORT="P":$P(^DPT(PAT,0),"^"),1:$P(^DPT(PAT,0),"^",9)),SIN)=SIN
I $G(PSORMZ) G BIG
I '$D(^TMP($J,"PSOSPLOG")) D HEAD W !!,"NO RECORDS TO PRINT",! D:$E(IOST)="C" D ^%ZISC G EXIT
.K DIR S DIR(0)="E" D ^DIR K DIR
S HPAT="",HDAT=""
F PSODATE=0:0 S PSODATE=$O(^TMP($J,"PSOSPLOG",PSODATE)) Q:'PSODATE!($G(QFLAG)) S (Y,PDAT)=PSODATE D DD^%DT S PSODATEX=Y D HEAD S PAT="" F S PAT=$O(^TMP($J,"PSOSPLOG",PSODATE,PAT)) Q:PAT=""!($G(QFLAG)) D
.F SINRX=0:0 S SINRX=$O(^TMP($J,"PSOSPLOG",PSODATE,PAT,SINRX)) Q:'SINRX!($G(QFLAG)) D
..S NODE=$G(^PS(52.5,SINRX,0)),PATPTR=+$P(NODE,"^",3)
..I 'PATPTR Q
..S PATNAME=$P($G(^DPT(PATPTR,0)),"^") Q:PATNAME=""
..I $G(PSPRINT),$G(^PS(52.5,SINRX,"P")) Q
..I $G(PSUSDIV),$G(PSOSITE)'=$P(NODE,"^",6) Q
..I PAT'=HPAT!(HDAT'=PDAT) W !!?9,"Patient Name: "_$G(PATNAME) S HPAT=PAT,PDAT=HDAT
..D:($Y+4)>IOSL HEAD Q:$G(QFLAG)
..S PSOINRX=+$P($G(NODE),"^")
..W !,$P($G(^PSRX(+$G(NODE),0)),"^")
..W ?13,$P($G(^PSDRUG(+$P($G(^PSRX(PSOINRX,0)),"^",6),0)),"^")
..K PSOMW D
...I $P(NODE,"^",5) S PSOMW=$P($G(^PSRX(+$G(NODE),"P",$P(NODE,"^",5),0)),"^",2) Q
...I $P(NODE,"^",13)!($O(^PSRX(+$G(NODE),1,0))) D Q
....I $P(NODE,"^",13) S PSOMW=$P($G(^PSRX(+$G(NODE),1,$P(NODE,"^",13),0)),"^",2) Q
....F PP=0:0 S PP=$O(^PSRX(+$G(NODE),1,PP)) Q:'PP S PSOMW=$P($G(^PSRX(+$G(NODE),1,PP,0)),"^",2)
...S PSOMW=$P($G(^PSRX(+$G(NODE),0)),"^",11)
..W ?54,$G(PSOMW)
..S PSOPRINT=$S($G(^PS(52.5,SINRX,"P")):"YES",1:"NO")
..W ?56,PSOPRINT
..I PSOPRINT="NO" S PSOBAD="" D CHKBAD I PSOBAD'="" W ?62,PSOBAD
..I $G(PSOSCMOP),$P(NODE,"^",7)'="" D
...W ?64,$S($P(NODE,"^",7)="Q":"QUEUED/TRANS",$P(NODE,"^",7)="X":"TRANS/COMPLETE",$P(NODE,"^",7)="L":"LOADING/TRANS",$P(NODE,"^",7)="P":"PRINTED/LOCAL",1:"")
I $E(IOST)'="P",'$G(QFLAG) W ! K DIR S DIR(0)="E" D ^DIR K DIR
W !,"NOTE: B=BAD ADDRESS INDICATOR D=NO NOT MAIL F=FOREIGN ADDRESS"
W !,"** END OF REPORT **"
D ^%ZISC G EXIT
HEAD ;
I $E(IOST)'="P",PAGE K DIR S DIR(0)="E",DIR("A")="Press Return to continue, '^' to exit" D ^DIR K DIR I 'Y S QFLAG=1 Q
W @IOF W !?22,"RX SUSPENSE LIST "_$S($G(PSODATEX)'="":"FOR ",1:"")_$G(PSODATEX) W ?68,"PAGE: ",$G(PAGE) W !,"RX #",?13,"DRUG",?53,"MW",?56,"PRNT B/D/F",?66,$S($G(PSOSCMOP):"CMOP STATUS",1:"") W !,LINE S PAGE=PAGE+1
Q
BIG ;
N PSOPRINT
I '$D(^TMP($J,"PSOSPLOG")) D HEADB W !!,"NO RECORDS TO PRINT",! D:$E(IOST)="C" D ^%ZISC G EXIT
.K DIR S DIR(0)="E" D ^DIR K DIR
F PSODATE=0:0 S PSODATE=$O(^TMP($J,"PSOSPLOG",PSODATE)) Q:'PSODATE!($G(QFLAG)) S Y=PSODATE D DD^%DT S PSODATEX=Y D:PAGE=1 HEADB D HEADND S PAT="" F S PAT=$O(^TMP($J,"PSOSPLOG",PSODATE,PAT)) Q:PAT=""!($G(QFLAG)) D
.F SINRX=0:0 S SINRX=$O(^TMP($J,"PSOSPLOG",PSODATE,PAT,SINRX)) Q:'SINRX!($G(QFLAG)) D
..S NODE=$G(^PS(52.5,SINRX,0)),PATPTR=+$P(NODE,"^",3)
..I 'PATPTR Q
..S PATNAME=$P($G(^DPT(PATPTR,0)),"^") Q:PATNAME=""
..I $G(PSPRINT),$G(^PS(52.5,SINRX,"P")) Q
..I $G(PSUSDIV),$G(PSOSITE)'=$P(NODE,"^",6) Q
..D:($Y+4)>IOSL HEADB Q:$G(QFLAG)
..S PSOINRX=+$P($G(NODE),"^")
..W !,$P($G(^PSRX(+$G(NODE),0)),"^")
..W ?13,$G(PATNAME)
..W ?45,$P($G(^PSDRUG(+$P($G(^PSRX(PSOINRX,0)),"^",6),0)),"^")
..K PSOMW D
...I $P(NODE,"^",5) S PSOMW=$P($G(^PSRX(+$G(NODE),"P",$P(NODE,"^",5),0)),"^",2) Q
...I $P(NODE,"^",13)!($O(^PSRX(+$G(NODE),1,0))) D Q
....I $P(NODE,"^",13) S PSOMW=$P($G(^PSRX(+$G(NODE),1,$P(NODE,"^",13),0)),"^",2) Q
....F PP=0:0 S PP=$O(^PSRX(+$G(NODE),1,PP)) Q:'PP S PSOMW=$P($G(^PSRX(+$G(NODE),1,PP,0)),"^",2)
...S PSOMW=$P($G(^PSRX(+$G(NODE),0)),"^",11)
..W ?88,$S($G(PSOMW)="W":"WINDOW",1:"MAIL")
..S PSOPRINT=$S($G(^PS(52.5,SINRX,"P")):"YES",1:"NO")
..W ?95,PSOPRINT
..I PSOPRINT="NO" S PSOBAD="" D CHKBAD I PSOBAD'="" W ?103,PSOBAD
..I $G(PSOSCMOP),$P(NODE,"^",7)'="" D
...W ?104,$S($P(NODE,"^",7)="Q":"QUEUED FOR TRANSMISSION",$P(NODE,"^",7)="X":"TRANSMISSION COMPLETED",$P(NODE,"^",7)="L":"LOADING FOR TRANSMISSION",$P(NODE,"^",7)="P":"PRINTED LOCALLY",1:"")
I $E(IOST)'="P",'$G(QFLAG) W ! K DIR S DIR(0)="E" D ^DIR K DIR
W !,"NOTE: B=BAD ADDRESS INDICATOR D=NO NOT MAIL F=FOREIGN ADDRESS"
W !,"** END OF REPORT **"
D ^%ZISC G EXIT
HEADB ;
I $E(IOST)'="P",PAGE K DIR S DIR(0)="E",DIR("A")="Press Return to continue, '^' to exit" D ^DIR K DIR I 'Y S QFLAG=1 Q
W @IOF
W !,"RX #",?13,"PATIENT",?45,"DRUG",?88,"TYPE",?93,"PRINTED B/D/F",?108,$S($G(PSOSCMOP):"CMOP STATUS",1:""),?122,"PAGE ",$G(PAGE) W !,LINE S PAGE=PAGE+1
Q
HEADND W !!?40,"RX SUSPENSE LIST "_$S($G(PSODATEX)'="":"FOR ",1:"")_$G(PSODATEX)
Q
;
CHKADDR ;
N PSOBADR,PSOTEMP
S PSOBADR=$$BADADR^DGUTL3(PSODFN)
I PSOBADR D
.S PSOTEMP=$$CHKTEMP^PSOBAI(PSODFN)
I PSOBADR,'PSOTEMP S (PSOBAI,PSOBDF("B"))=1 Q
Q
;
FOREIGN ;
N PSOFORGN,DFN
S DFN=PSODFN D ADD^VADPT
S PSOFORGN=$P($G(VAPA(25)),"^",2) I PSOFORGN'="" D ;*362
.N PSON
.S PSOBDF("F")=1
.S PSON=$$GET1^DIQ(59,PSOSITE,.01)
.I PSON'["MANILA",PSOFORGN["UNITED STATES" K PSOBDF("F") Q
.I PSON["MANILA",PSOFORGN["PHILIPPINES" K PSOBDF("F")
Q
;
CHKMAIL ;
N PSOTEMP,MAILEXP,MAILST
S PSOTEMP=$G(^PS(55,PSODFN,0))
S MAILST=$P(PSOTEMP,"^",3)
S MAILEXP=$P(PSOTEMP,"^",5)
I +$G(NODE),$$GET1^DIQ(52,+$G(NODE),100.2,"I")]"" S MAILST=$$GET1^DIQ(52,+$G(NODE),100.2,"I"),MAILEXP="" ;p753
Q:MAILST'=2
I MAILEXP=""!(MAILEXP>DT) S PSOBDF("D")=1
Q
;
CHKBAD ;
K PSOBDF
S PSODFN=PATPTR
D CHKADDR I $D(PSOBDF) S PSOBAD=$O(PSOBDF("")) K PSOBDF Q
D CHKMAIL I $D(PSOBDF) S PSOBAD=$O(PSOBDF("")) K PSOBDF Q
D FOREIGN I $D(PSOBDF) S PSOBAD=$O(PSOBDF("")) K PSOBDF Q
Q
; CHANGE TO USE FOLLOWING IF WANT TO SEE WHY RX'S DID NOT PRINT PREVIOUSLY (INSTEAD OF CURRENT BAD STATUS)
N RX,SEQ,FILL,ZZ
S RX=+$G(NODE),FILL=$P(NODE,"^",13)
S SEQ=0 F S SEQ=$O(^PSRX(RX,"A",SEQ)) Q:'SEQ S X=$G(^PSRX(RX,"A",SEQ,0)) D
.I $P(X,"^",2)="S" S ZZ=$P(X,"^",4),ZZ=$S(ZZ<6:ZZ,1:ZZ-1) I ZZ=FILL,X["due to" D
..I X["DO NOT MAIL" S PSOBAD="D" Q
..I X["BAD ADDRESS" S PSOBAD="B" Q
..I X["FOREIGN ADDRESS" S PSOBAD="F" Q
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOSULOG 9175 printed Dec 13, 2024@02:35:31 Page 2
PSOSULOG ;BHAM ISC/RTR-Log of prescriptions on suspense by day ; 11/18/92
+1 ;;7.0;OUTPATIENT PHARMACY;**18,264,362,753**;DEC 1997;Build 53
+2 IF '$GET(PSOSITE)
DO ^PSOLSET
IF '$GET(PSOSITE)
DO WARN^PSOSUDCN
QUIT
+3 KILL ^TMP($JOB,"PSOSPLOG")
NEW BDATE,EDATE,GG,HDAT,HPAT,PII,LINE,NODE,PAGE,PAT,PATNAME,PATPTR,PDAT,PP,PSOSCMOP,PSOCNT,PSODATE,PSODATEX,PSOINRX,PSORT,PSPRINT,PSUSDIV,QFLAG,SIN,SINRX,X,Y,ZZ
LOG WRITE !
KILL DIR
SET DIR("A")="Sort by Patient Name or SSN"
SET DIR(0)="SB^P:PATIENT NAME;S:SOCIAL SECURITY NUMBER"
SET DIR("B")="PATIENT NAME"
+1 SET DIR("?")="Enter 'P' to sort by patient name, 'S' to sort by SSN, enter '^' to exit."
+2 DO ^DIR
KILL DIR
if $DATA(DIRUT)
DO MESS
if $DATA(DIRUT)
GOTO EXIT
SET PSORT=Y
DATE WRITE !
KILL %DT
SET %DT="AEX"
SET %DT("A")="Start Date: "
DO ^%DT
KILL %DT
if Y=-1&(X'["^")
GOTO DATE
IF X["^"!($DATA(DTOUT))
DO MESS
GOTO EXIT
EDATE WRITE !
SET BDATE=$EXTRACT(Y,1,7)
SET %DT(0)=BDATE
SET %DT="AEX"
SET %DT("A")="End Date: "
DO ^%DT
KILL %DT
if Y=-1&(X'["^")
GOTO EDATE
IF X["^"!($DATA(DTOUT))
DO MESS
GOTO EXIT
+1 SET EDATE=$EXTRACT(Y,1,7)
WRITE !
+2 WRITE !
KILL DIR
SET DIR(0)="Y"
SET DIR("B")="Y"
SET DIR("A")="Do you want to see only those Rx's that have NOT yet been printed"
DO ^DIR
KILL DIR
if $DATA(DIRUT)
DO MESS
if Y["^"!($DATA(DIRUT))
GOTO EXIT
SET PSPRINT=$SELECT(Y:1,1:0)
+3 SET PSOCNT=0
FOR PII=0:0
SET PII=$ORDER(^PS(59,PII))
if 'PII
QUIT
SET PSOCNT=PSOCNT+1
+4 IF PSOCNT=1
GOTO SKIP
+5 WRITE !!?3,"You are logged in under the "_$PIECE($GET(^PS(59,+$GET(PSOSITE),0)),"^")_" division.",!
+6 KILL DIR
SET DIR(0)="Y"
SET DIR("B")="Yes"
SET DIR("A")="Print only those Rx's suspended for this division"
SET DIR("?")="Enter 'Yes' to print only those Rx's for this division, enter 'No' to print Rx's suspended for all divisions."
+7 DO ^DIR
KILL DIR
IF Y["^"!($DATA(DIRUT))
DO MESS
GOTO EXIT
+8 SET PSUSDIV=Y
SKIP ;
+1 IF '$GET(PSXSYS)
GOTO SKIPC
+2 KILL DIR
WRITE !
SET DIR(0)="Y"
SET DIR("B")="N"
SET DIR("A")="Do you want suspended CMOP Rx's included in this report"
DO ^DIR
KILL DIR
IF Y["^"!($DATA(DIRUT))
DO MESS
GOTO EXIT
+3 IF $GET(Y)
SET PSOSCMOP=1
SKIPC ;
+1 WRITE !
KILL DIR
SET DIR("A")="Do you want this report to print in 80 or 132 column format: "
SET DIR("B")="132"
SET DIR(0)="SAM^1:132;8:80"
DO ^DIR
KILL DIR
IF Y["^"!($DATA(DIRUT))
DO MESS
GOTO EXIT
+2 WRITE !
SET PSORMZ=$SELECT(Y=1:1,1:0)
+3 KILL IOP,%ZIS,POP
SET %ZIS="QM"
DO ^%ZIS
IF POP
DO MESS
GOTO EXIT
+4 IF $DATA(IO("Q"))
SET ZTRTN="REP^PSOSULOG"
SET ZTDESC="Report is suspended Rx's"
Begin DoDot:1
+5 FOR GG="PSORMZ","PSOSITE","PSOPAR","PSORT","BDATE","EDATE","PSPRINT","PSUSDIV","PSOSCMOP"
if $DATA(@GG)
SET ZTSAVE(GG)=""
+6 DO ^%ZTLOAD
WRITE !,"Task queued to print"
End DoDot:1
GOTO EXIT
+7 GOTO REP
EXIT ;
+1 KILL ^TMP($JOB,"PSOSPLOG")
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 KILL BDATE,EDATE,GG,HDAT,HPAT,PII,LINE,NODE,PAGE,PAT,PATNAME,PATPTR,PDAT,PP,PSOBAD,PSOSCMOP,PSOCNT,PSODATE,PSODATEX,PSOINRX,PSORMZ,PSORT,PSPRINT,PSUSDIV,QFLAG,SIN,SINRX,X,Y,ZZ
+3 QUIT
MESS WRITE !!,"No report printed!",!!
QUIT
REP ;
+1 KILL ^TMP($JOB,"PSOSPLOG")
+2 USE IO
SET $PIECE(LINE,"-",$SELECT($GET(PSORMZ):130,1:79))=""
+3 SET BDATE=BDATE-.0001
SET QFLAG=0
SET PAGE=1
+4 FOR ZZ=BDATE:0
SET ZZ=$ORDER(^PS(52.5,"C",ZZ))
if 'ZZ!(ZZ>EDATE)
QUIT
FOR SIN=0:0
SET SIN=$ORDER(^PS(52.5,"C",ZZ,SIN))
if 'SIN
QUIT
Begin DoDot:1
+5 if '$PIECE($GET(^PS(52.5,SIN,0)),"^",3)
QUIT
+6 IF $GET(PSPRINT)
IF $GET(^PS(52.5,SIN,"P"))
QUIT
+7 IF '$GET(PSOSCMOP)
IF $PIECE($GET(^PS(52.5,SIN,0)),"^",7)'=""
QUIT
+8 IF $GET(PSUSDIV)
IF $GET(PSOSITE)'=$PIECE($GET(^PS(52.5,SIN,0)),"^",6)
QUIT
+9 SET PAT=+$PIECE($GET(^PS(52.5,SIN,0)),"^",3)
IF $PIECE($GET(^DPT(PAT,0)),"^")=""
QUIT
+10 IF $PIECE($GET(^DPT(PAT,0)),"^",9)=""
IF PSORT="S"
QUIT
+11 SET ^TMP($JOB,"PSOSPLOG",ZZ,$SELECT(PSORT="P":$PIECE(^DPT(PAT,0),"^"),1:$PIECE(^DPT(PAT,0),"^",9)),SIN)=SIN
End DoDot:1
+12 IF $GET(PSORMZ)
GOTO BIG
+13 IF '$DATA(^TMP($JOB,"PSOSPLOG"))
DO HEAD
WRITE !!,"NO RECORDS TO PRINT",!
if $EXTRACT(IOST)="C"
Begin DoDot:1
+14 KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
End DoDot:1
DO ^%ZISC
GOTO EXIT
+15 SET HPAT=""
SET HDAT=""
+16 FOR PSODATE=0:0
SET PSODATE=$ORDER(^TMP($JOB,"PSOSPLOG",PSODATE))
if 'PSODATE!($GET(QFLAG))
QUIT
SET (Y,PDAT)=PSODATE
DO DD^%DT
SET PSODATEX=Y
DO HEAD
SET PAT=""
FOR
SET PAT=$ORDER(^TMP($JOB,"PSOSPLOG",PSODATE,PAT))
if PAT=""!($GET(QFLAG))
QUIT
Begin DoDot:1
+17 FOR SINRX=0:0
SET SINRX=$ORDER(^TMP($JOB,"PSOSPLOG",PSODATE,PAT,SINRX))
if 'SINRX!($GET(QFLAG))
QUIT
Begin DoDot:2
+18 SET NODE=$GET(^PS(52.5,SINRX,0))
SET PATPTR=+$PIECE(NODE,"^",3)
+19 IF 'PATPTR
QUIT
+20 SET PATNAME=$PIECE($GET(^DPT(PATPTR,0)),"^")
if PATNAME=""
QUIT
+21 IF $GET(PSPRINT)
IF $GET(^PS(52.5,SINRX,"P"))
QUIT
+22 IF $GET(PSUSDIV)
IF $GET(PSOSITE)'=$PIECE(NODE,"^",6)
QUIT
+23 IF PAT'=HPAT!(HDAT'=PDAT)
WRITE !!?9,"Patient Name: "_$GET(PATNAME)
SET HPAT=PAT
SET PDAT=HDAT
+24 if ($Y+4)>IOSL
DO HEAD
if $GET(QFLAG)
QUIT
+25 SET PSOINRX=+$PIECE($GET(NODE),"^")
+26 WRITE !,$PIECE($GET(^PSRX(+$GET(NODE),0)),"^")
+27 WRITE ?13,$PIECE($GET(^PSDRUG(+$PIECE($GET(^PSRX(PSOINRX,0)),"^",6),0)),"^")
+28 KILL PSOMW
Begin DoDot:3
+29 IF $PIECE(NODE,"^",5)
SET PSOMW=$PIECE($GET(^PSRX(+$GET(NODE),"P",$PIECE(NODE,"^",5),0)),"^",2)
QUIT
+30 IF $PIECE(NODE,"^",13)!($ORDER(^PSRX(+$GET(NODE),1,0)))
Begin DoDot:4
+31 IF $PIECE(NODE,"^",13)
SET PSOMW=$PIECE($GET(^PSRX(+$GET(NODE),1,$PIECE(NODE,"^",13),0)),"^",2)
QUIT
+32 FOR PP=0:0
SET PP=$ORDER(^PSRX(+$GET(NODE),1,PP))
if 'PP
QUIT
SET PSOMW=$PIECE($GET(^PSRX(+$GET(NODE),1,PP,0)),"^",2)
End DoDot:4
QUIT
+33 SET PSOMW=$PIECE($GET(^PSRX(+$GET(NODE),0)),"^",11)
End DoDot:3
+34 WRITE ?54,$GET(PSOMW)
+35 SET PSOPRINT=$SELECT($GET(^PS(52.5,SINRX,"P")):"YES",1:"NO")
+36 WRITE ?56,PSOPRINT
+37 IF PSOPRINT="NO"
SET PSOBAD=""
DO CHKBAD
IF PSOBAD'=""
WRITE ?62,PSOBAD
+38 IF $GET(PSOSCMOP)
IF $PIECE(NODE,"^",7)'=""
Begin DoDot:3
+39 WRITE ?64,$SELECT($PIECE(NODE,"^",7)="Q":"QUEUED/TRANS",$PIECE(NODE,"^",7)="X":"TRANS/COMPLETE",$PIECE(NODE,"^",7)="L":"LOADING/TRANS",$PIECE(NODE,"^",7)="P":"PRINTED/LOCAL",1:"")
End DoDot:3
End DoDot:2
End DoDot:1
+40 IF $EXTRACT(IOST)'="P"
IF '$GET(QFLAG)
WRITE !
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
+41 WRITE !,"NOTE: B=BAD ADDRESS INDICATOR D=NO NOT MAIL F=FOREIGN ADDRESS"
+42 WRITE !,"** END OF REPORT **"
+43 DO ^%ZISC
GOTO EXIT
HEAD ;
+1 IF $EXTRACT(IOST)'="P"
IF PAGE
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue, '^' to exit"
DO ^DIR
KILL DIR
IF 'Y
SET QFLAG=1
QUIT
+2 WRITE @IOF
WRITE !?22,"RX SUSPENSE LIST "_$SELECT($GET(PSODATEX)'="":"FOR ",1:"")_$GET(PSODATEX)
WRITE ?68,"PAGE: ",$GET(PAGE)
WRITE !,"RX #",?13,"DRUG",?53,"MW",?56,"PRNT B/D/F",?66,$SELECT($GET(PSOSCMOP):"CMOP STATUS",1:"")
WRITE !,LINE
SET PAGE=PAGE+1
+3 QUIT
BIG ;
+1 NEW PSOPRINT
+2 IF '$DATA(^TMP($JOB,"PSOSPLOG"))
DO HEADB
WRITE !!,"NO RECORDS TO PRINT",!
if $EXTRACT(IOST)="C"
Begin DoDot:1
+3 KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
End DoDot:1
DO ^%ZISC
GOTO EXIT
+4 FOR PSODATE=0:0
SET PSODATE=$ORDER(^TMP($JOB,"PSOSPLOG",PSODATE))
if 'PSODATE!($GET(QFLAG))
QUIT
SET Y=PSODATE
DO DD^%DT
SET PSODATEX=Y
if PAGE=1
DO HEADB
DO HEADND
SET PAT=""
FOR
SET PAT=$ORDER(^TMP($JOB,"PSOSPLOG",PSODATE,PAT))
if PAT=""!($GET(QFLAG))
QUIT
Begin DoDot:1
+5 FOR SINRX=0:0
SET SINRX=$ORDER(^TMP($JOB,"PSOSPLOG",PSODATE,PAT,SINRX))
if 'SINRX!($GET(QFLAG))
QUIT
Begin DoDot:2
+6 SET NODE=$GET(^PS(52.5,SINRX,0))
SET PATPTR=+$PIECE(NODE,"^",3)
+7 IF 'PATPTR
QUIT
+8 SET PATNAME=$PIECE($GET(^DPT(PATPTR,0)),"^")
if PATNAME=""
QUIT
+9 IF $GET(PSPRINT)
IF $GET(^PS(52.5,SINRX,"P"))
QUIT
+10 IF $GET(PSUSDIV)
IF $GET(PSOSITE)'=$PIECE(NODE,"^",6)
QUIT
+11 if ($Y+4)>IOSL
DO HEADB
if $GET(QFLAG)
QUIT
+12 SET PSOINRX=+$PIECE($GET(NODE),"^")
+13 WRITE !,$PIECE($GET(^PSRX(+$GET(NODE),0)),"^")
+14 WRITE ?13,$GET(PATNAME)
+15 WRITE ?45,$PIECE($GET(^PSDRUG(+$PIECE($GET(^PSRX(PSOINRX,0)),"^",6),0)),"^")
+16 KILL PSOMW
Begin DoDot:3
+17 IF $PIECE(NODE,"^",5)
SET PSOMW=$PIECE($GET(^PSRX(+$GET(NODE),"P",$PIECE(NODE,"^",5),0)),"^",2)
QUIT
+18 IF $PIECE(NODE,"^",13)!($ORDER(^PSRX(+$GET(NODE),1,0)))
Begin DoDot:4
+19 IF $PIECE(NODE,"^",13)
SET PSOMW=$PIECE($GET(^PSRX(+$GET(NODE),1,$PIECE(NODE,"^",13),0)),"^",2)
QUIT
+20 FOR PP=0:0
SET PP=$ORDER(^PSRX(+$GET(NODE),1,PP))
if 'PP
QUIT
SET PSOMW=$PIECE($GET(^PSRX(+$GET(NODE),1,PP,0)),"^",2)
End DoDot:4
QUIT
+21 SET PSOMW=$PIECE($GET(^PSRX(+$GET(NODE),0)),"^",11)
End DoDot:3
+22 WRITE ?88,$SELECT($GET(PSOMW)="W":"WINDOW",1:"MAIL")
+23 SET PSOPRINT=$SELECT($GET(^PS(52.5,SINRX,"P")):"YES",1:"NO")
+24 WRITE ?95,PSOPRINT
+25 IF PSOPRINT="NO"
SET PSOBAD=""
DO CHKBAD
IF PSOBAD'=""
WRITE ?103,PSOBAD
+26 IF $GET(PSOSCMOP)
IF $PIECE(NODE,"^",7)'=""
Begin DoDot:3
+27 WRITE ?104,$SELECT($PIECE(NODE,"^",7)="Q":"QUEUED FOR TRANSMISSION",$PIECE(NODE,"^",7)="X":"TRANSMISSION COMPLETED",$PIECE(NODE,"^",7)="L":"LOADING FOR TRANSMISSION",$PIECE(NODE,"^",7)="P":"PRINTED LOCALLY",1:"")
End DoDot:3
End DoDot:2
End DoDot:1
+28 IF $EXTRACT(IOST)'="P"
IF '$GET(QFLAG)
WRITE !
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
+29 WRITE !,"NOTE: B=BAD ADDRESS INDICATOR D=NO NOT MAIL F=FOREIGN ADDRESS"
+30 WRITE !,"** END OF REPORT **"
+31 DO ^%ZISC
GOTO EXIT
HEADB ;
+1 IF $EXTRACT(IOST)'="P"
IF PAGE
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue, '^' to exit"
DO ^DIR
KILL DIR
IF 'Y
SET QFLAG=1
QUIT
+2 WRITE @IOF
+3 WRITE !,"RX #",?13,"PATIENT",?45,"DRUG",?88,"TYPE",?93,"PRINTED B/D/F",?108,$SELECT($GET(PSOSCMOP):"CMOP STATUS",1:""),?122,"PAGE ",$GET(PAGE)
WRITE !,LINE
SET PAGE=PAGE+1
+4 QUIT
HEADND WRITE !!?40,"RX SUSPENSE LIST "_$SELECT($GET(PSODATEX)'="":"FOR ",1:"")_$GET(PSODATEX)
+1 QUIT
+2 ;
CHKADDR ;
+1 NEW PSOBADR,PSOTEMP
+2 SET PSOBADR=$$BADADR^DGUTL3(PSODFN)
+3 IF PSOBADR
Begin DoDot:1
+4 SET PSOTEMP=$$CHKTEMP^PSOBAI(PSODFN)
End DoDot:1
+5 IF PSOBADR
IF 'PSOTEMP
SET (PSOBAI,PSOBDF("B"))=1
QUIT
+6 QUIT
+7 ;
FOREIGN ;
+1 NEW PSOFORGN,DFN
+2 SET DFN=PSODFN
DO ADD^VADPT
+3 ;*362
SET PSOFORGN=$PIECE($GET(VAPA(25)),"^",2)
IF PSOFORGN'=""
Begin DoDot:1
+4 NEW PSON
+5 SET PSOBDF("F")=1
+6 SET PSON=$$GET1^DIQ(59,PSOSITE,.01)
+7 IF PSON'["MANILA"
IF PSOFORGN["UNITED STATES"
KILL PSOBDF("F")
QUIT
+8 IF PSON["MANILA"
IF PSOFORGN["PHILIPPINES"
KILL PSOBDF("F")
End DoDot:1
+9 QUIT
+10 ;
CHKMAIL ;
+1 NEW PSOTEMP,MAILEXP,MAILST
+2 SET PSOTEMP=$GET(^PS(55,PSODFN,0))
+3 SET MAILST=$PIECE(PSOTEMP,"^",3)
+4 SET MAILEXP=$PIECE(PSOTEMP,"^",5)
+5 ;p753
IF +$GET(NODE)
IF $$GET1^DIQ(52,+$GET(NODE),100.2,"I")]""
SET MAILST=$$GET1^DIQ(52,+$GET(NODE),100.2,"I")
SET MAILEXP=""
+6 if MAILST'=2
QUIT
+7 IF MAILEXP=""!(MAILEXP>DT)
SET PSOBDF("D")=1
+8 QUIT
+9 ;
CHKBAD ;
+1 KILL PSOBDF
+2 SET PSODFN=PATPTR
+3 DO CHKADDR
IF $DATA(PSOBDF)
SET PSOBAD=$ORDER(PSOBDF(""))
KILL PSOBDF
QUIT
+4 DO CHKMAIL
IF $DATA(PSOBDF)
SET PSOBAD=$ORDER(PSOBDF(""))
KILL PSOBDF
QUIT
+5 DO FOREIGN
IF $DATA(PSOBDF)
SET PSOBAD=$ORDER(PSOBDF(""))
KILL PSOBDF
QUIT
+6 QUIT
+7 ; CHANGE TO USE FOLLOWING IF WANT TO SEE WHY RX'S DID NOT PRINT PREVIOUSLY (INSTEAD OF CURRENT BAD STATUS)
+8 NEW RX,SEQ,FILL,ZZ
+9 SET RX=+$GET(NODE)
SET FILL=$PIECE(NODE,"^",13)
+10 SET SEQ=0
FOR
SET SEQ=$ORDER(^PSRX(RX,"A",SEQ))
if 'SEQ
QUIT
SET X=$GET(^PSRX(RX,"A",SEQ,0))
Begin DoDot:1
+11 IF $PIECE(X,"^",2)="S"
SET ZZ=$PIECE(X,"^",4)
SET ZZ=$SELECT(ZZ<6:ZZ,1:ZZ-1)
IF ZZ=FILL
IF X["due to"
Begin DoDot:2
+12 IF X["DO NOT MAIL"
SET PSOBAD="D"
QUIT
+13 IF X["BAD ADDRESS"
SET PSOBAD="B"
QUIT
+14 IF X["FOREIGN ADDRESS"
SET PSOBAD="F"
QUIT
End DoDot:2
End DoDot:1
+15 QUIT
+16 ;
