PSOSULOG ;BHAM ISC/RTR-Log of prescriptions on suspense by day ; 11/18/92
 ;;7.0;OUTPATIENT PHARMACY;**18,264**;DEC 1997;Build 19
 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'="",PSOFORGN'["UNITED STATES" S PSOBDF("F")=1
 Q
 ;
CHKMAIL  ;
 N PSOTEMP,MAILEXP
 S PSOTEMP=$G(^PS(55,PSODFN,0)) Q:$P(PSOTEMP,"^",3)'=2
 S MAILEXP=$P(PSOTEMP,"^",5) 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
 ;