- 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 Feb 19, 2025@00:01:56 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 ;