| [613] | 1 | PSJEXP ;BIR/CML3,KKA-MEDICATION EXPIRATION NOTICES ;13 FEB 96 / 10:04 AM
|
|---|
| 2 | ;;5.0; INPATIENT MEDICATIONS ;**111**;16 DEC 97
|
|---|
| 3 | ;
|
|---|
| 4 | ;Reference to ^PS(55 supported by DBIA #2191.
|
|---|
| 5 | ;
|
|---|
| 6 | N OUT,PSJNEW,PSGPTMP,PPAGE S PSJNEW=1
|
|---|
| 7 | D ENCV^PSGSETU I $D(XQUIT) Q
|
|---|
| 8 | K %DT,DIC S (PSGP,WD,WG)=0,PSGSSH="EXP" S PSGPTMP=0,PPAGE=1 D ^PSGSEL G:"^"[PSGSS DONE D @PSGSS G:+Y'>0 DONE
|
|---|
| 9 | I PSGSS="W" S PSJSEL("W")=WD D ADMTM^PSJPDIR
|
|---|
| 10 | I PSGSS="C" S PSJSEL("C")="C"
|
|---|
| 11 | S %DT="ETX",D="start" D DT G:Y'>0 DONE S (%DT(0),PSGEXPS)=+Y,D="stop" D DT K %DT G:Y'>0 DONE S:'$P(PSGEXPS,".",2) PSGEXPS=PSGEXPS+.0001 S PSGEXPF=Y+$S($P(Y,".",2):0,1:.24)
|
|---|
| 12 | D LIST^PSJEXP0 G:$D(OUT) DONE
|
|---|
| 13 | K ZTDTH,ZTSAVE S PSGTIR="ENQ^PSJEXP",ZTDESC="INPATIENT STOP ORDER NOTICES" F X="PSJMSG","WG","WD","PSGP","PSGOP","PSGDT","PSGEXPS","PSGEXPF","PSGSS","CHOICE","PSGPTMP","PPAGE","PSJSEL(" S ZTSAVE(X)=""
|
|---|
| 14 | D ENDEV^PSGTI I POP!$D(ZTSK) W:POP !?3,"No device selected for report run." G DONE
|
|---|
| 15 | W:$E(IOST)'="P" !,"...this may take a few minutes...",!?25,"...you really should QUEUE this report, if possible..."
|
|---|
| 16 | ENQ D NOW^%DTC S PSGDT=%,SD=$$EN^PSGCT(PSGEXPS,-1),FD=PSGEXPF F X="PSGEXPS","PSGEXPF" S @X=$$ENDTC^PSGMI(@X)
|
|---|
| 17 | K ^TMP("PSG",$J) D @("L"_PSGSS),^PSJEXP0
|
|---|
| 18 | DONE D ^%ZISC D ENKV^PSGSETU K %,^TMP("PSG",$J),ADCNT,AM,CHOICE,CNT,D,DFN,DO,DOB,DRG,DRGI,DRGN,DRGT,DTOUT,DUOUT,FD,FSTFLG,GMRAREC,IR,JJ,LNCNT,MR,PSJMSG,ND,ND3,ND4,NF,ON,OPI,PRIMD,P,PSIVUP,PSJORIFN
|
|---|
| 19 | K PSJACNWP,PSJAD,PSJJORD,PSJPAD,PSJPAGE,PSJPDOB,PSJPDX,PSJPRB,PSJPSEX,PSJPTD,PSJPWD,PSJPWDN,PSJPWT,PSJSEL,PSJSOL,SLS,Y1
|
|---|
| 20 | K POP,PPN,PR,PSGDT,PSGEXPF,PSGEXPS,PSGOD,PSGP,PSGSS,PSGSSH,PSGTIR,PSEX,PSJOPC,PST,Q,RF,SCH,SD,SD1,SD1IV,SEX,SI,SM,SNDFLG,SOLCNT,SSN,ST,STD,TEAM,TEMPTM,TM,VA,WCNT,WD,WDN,WG,WRD,WS,WT,X,XQUIT,Y
|
|---|
| 21 | Q
|
|---|
| 22 | LC ;
|
|---|
| 23 | S STDTE=0 F S STDTE=$O(^PS(55,"AIVC",STDTE)) Q:'STDTE S CLINIC=0 F S CLINIC=$O(^PS(55,"AIVC",STDTE,CLINIC)) Q:'CLINIC D
|
|---|
| 24 | . S JDFN=0 F S JDFN=$O(^PS(55,"AIVC",STDTE,CLINIC,JDFN)) Q:'JDFN S PSGP=JDFN D LP
|
|---|
| 25 | S STDTE=0 F S STDTE=$O(^PS(55,"AUDC",STDTE)) Q:'STDTE S CLINIC=0 F S CLINIC=$O(^PS(55,"AUDC",STDTE,CLINIC)) Q:'CLINIC D
|
|---|
| 26 | . S JDFN=0 F S JDFN=$O(^PS(55,"AUDC",STDTE,CLINIC,JDFN)) Q:'JDFN S PSGP=JDFN D LP
|
|---|
| 27 | Q
|
|---|
| 28 | ;
|
|---|
| 29 | LG F WD=0:0 S WD=$O(^PS(57.5,"AC",WG,WD)) Q:'WD D LW
|
|---|
| 30 | Q
|
|---|
| 31 | LW I $D(^DIC(42,WD,0)),$P(^(0),"^")]"" S WDN=$P(^(0),"^")
|
|---|
| 32 | E Q
|
|---|
| 33 | F PSGP=0:0 S PSGP=$O(^DPT("CN",WDN,PSGP)) Q:'PSGP D LP
|
|---|
| 34 | Q
|
|---|
| 35 | LL S CL="" F S CL=$O(^PS(57.8,"AD",CG,CL)) Q:CL="" D LC
|
|---|
| 36 | Q
|
|---|
| 37 | C ;
|
|---|
| 38 | K DIR S DIR(0)="FAO",DIR("A")="Select CLINIC: "
|
|---|
| 39 | S DIR("?")="^D CDIC^PSGVBW" W ! D ^DIR
|
|---|
| 40 | CDIC ;
|
|---|
| 41 | K DIC S DIC="^SC(",DIC(0)="QEMIZ" D ^DIC K DIC S:+Y>0 CL=+Y
|
|---|
| 42 | W:X["?" !!,"Enter the clinic you want to use to select patients for processing.",!
|
|---|
| 43 | Q
|
|---|
| 44 | L ;
|
|---|
| 45 | K DIR S DIR(0)="FAO",DIR("A")="Select CLINIC GROUP: "
|
|---|
| 46 | S DIR("?")="^D LDIC^PSGVBW" W ! D ^DIR
|
|---|
| 47 | LDIC ;
|
|---|
| 48 | K DIC S DIC="^PS(57.8,",DIC(0)="QEMI" D ^DIC K DIC S:+Y>0 CG=+Y
|
|---|
| 49 | W:X["?" !!,"Enter the name of the clinic group you want to use to select patients for processing."
|
|---|
| 50 | Q
|
|---|
| 51 | LP N PSJACNWP S PSJACNWP=1 D ^PSJAC,ENUNM^PSGOU Q:'$O(^PS(55,PSGP,5,"AUS",SD))
|
|---|
| 52 | S PPN=$E($P(PSGP(0),"^"),1,12)_"^"_PSGP S:PSJPRB="" PSJPRB="zz"
|
|---|
| 53 | S TM=$O(PSJSEL("TM","")),TM=$S(TM="":"ZZ",PSJPRB="":"zz",$D(^PS(57.7,+PSJPWD,1,+$O(^PS(57.7,"AWRT",+PSJPWD,PSJPRB,0)),0)):$P(^(0),"^"),1:"zz")
|
|---|
| 54 | S TEMPTM=$O(^PS(57.7,+PSJPWD,1,"B",TM,0))
|
|---|
| 55 | Q:$D(PSJSEL("TM"))&('$D(PSJSEL("TM","ALL")))&('$D(PSJSEL("TM",+TEMPTM)))
|
|---|
| 56 | D:CHOICE'="IV" GS D:CHOICE'="UD" GSIV
|
|---|
| 57 | Q
|
|---|
| 58 | GS F PST="C","P","R" F SD1=SD:0 S SD1=$O(^PS(55,PSGP,5,"AU",PST,SD1)) Q:'SD1!(SD1>FD) F PSJJORD=0:0 S PSJJORD=$O(^PS(55,PSGP,5,"AU",PST,SD1,PSJJORD)) Q:'PSJJORD I $D(^PS(55,PSGP,5,PSJJORD,0)),$P(^(0),U,9)'["D",$P(^(0),U,27)'["R" D ARSET
|
|---|
| 59 | I $D(^TMP("PSG",$J,$E(TM,1,10),$E(PSJPWDN,1,10),$E(PSJPRB,1,12),PPN)) S ^(PPN)=TM_"^"_PSJPWDN_"^"_PSJPRB_"^"_$P(PSGP(0),"^")_"^"_$P(PSJPSEX,"^",2)_"^"_$P(PSJPDOB,"^",2)_";"_PSJPAGE_"^"_VA("PID")_"^"_PSJPDX_"^"_PSJPWT
|
|---|
| 60 | ;naked reference below refers to the full global references to ^TMP on the line above
|
|---|
| 61 | I S ^(PPN)=^(PPN)_"^"_$P(PSJPAD,"^",2)_"^"_$P(PSJPTD,"^",2)
|
|---|
| 62 | Q
|
|---|
| 63 | GSIV S PST="C"
|
|---|
| 64 | S SD1IV=SD F S SD1IV=$O(^PS(55,PSGP,"IV","AIS",SD1IV)) Q:'SD1IV!(SD1IV>FD) F PSJJORD=0:0 S PSJJORD=$O(^PS(55,PSGP,"IV","AIS",SD1IV,PSJJORD)) Q:'PSJJORD D
|
|---|
| 65 | .I $D(^PS(55,PSGP,"IV",PSJJORD,0)),$P(^(0),U,17)'["D",$P(^PS(55,PSGP,"IV",PSJJORD,2),U,9)'["R" D ARSETIV
|
|---|
| 66 | I $D(^TMP("PSG",$J,$E(TM,1,10),$E(PSJPWDN,1,10),$E(PSJPRB,1,12),PPN)) S ^(PPN)=TM_"^"_PSJPWDN_"^"_PSJPRB_"^"_$P(PSGP(0),"^")_"^"_$P(PSJPSEX,"^",2)_"^"_$P(PSJPDOB,"^",2)_";"_PSJPAGE_"^"_VA("PID")_"^"_PSJPDX_"^"_PSJPWT
|
|---|
| 67 | ;naked reference below refers to the full global references to ^TMP on the line above
|
|---|
| 68 | I S ^(PPN)=^(PPN)_"^"_$P(PSJPAD,"^",2)_"^"_$P(PSJPTD,"^",2)
|
|---|
| 69 | Q
|
|---|
| 70 | ARSET S ND=$G(^PS(55,PSGP,5,PSJJORD,0)),PR=$P(ND,"^",2),ST=$P(ND,"^",9),MR=$P(ND,"^",3),PR=$$ENNPN^PSGMI(PR)
|
|---|
| 71 | S MR=$$ENMRN^PSGMI(MR) S X=$$NFWS^PSJUTL1(PSGP,PSJJORD_"U",PSJPWD),SM=$S('$P(X,U,3):0,$P(X,U,4):1,1:2)
|
|---|
| 72 | S ND=$G(^PS(55,PSGP,5,PSJJORD,2)),DRG=$G(^(.2)),SCH=$P(ND,"^"),STD=$P(ND,"^",2)\1,DO=$P(DRG,"^",2) I DO]"",$E(DO,$L(DO))'=" " S DO=DO_" "
|
|---|
| 73 | N X,PSG
|
|---|
| 74 | D DRGDISP^PSJLMUT1(PSGP,PSJJORD_"U",15,0,.PSG,1)
|
|---|
| 75 | S DRG=PSG(1) I $G(PSJPWDN)="" S PSJPWDN="UNKNOWN"
|
|---|
| 76 | S ^TMP("PSG",$J,$E(TM,1,10),$E(PSJPWDN,1,10),$E(PSJPRB,1,12),PPN,SD1,PST,$S(DRG'="NOT FOUND":$E(DRG,1,15),1:"zz")_"^"_PSJJORD)=DRG_"^"_STD_"^"_DO_MR_" "_SCH_"^"_ST_"^"_PR_"^^^"_SM Q
|
|---|
| 77 | ;
|
|---|
| 78 | ARSETIV N X,ON55 S DFN=PSGP,ON=PSJJORD D GT55^PSIVORFB
|
|---|
| 79 | S DRG=$S($G(DRG("AD",1))]"":$P(DRG("AD",1),U,2),1:$P($G(DRG("SOL",1)),U,2)),STD=P(2)\1,MR=$P(P("MR"),U,2),SCH=P(9),IR=P(8),ST=P(17),PR=$P(P(6),U,2)
|
|---|
| 80 | I $G(PSJPWDN)="" S PSJPWDN="UNKNOWN"
|
|---|
| 81 | S ^TMP("PSG",$J,$E(TM,1,10),$E(PSJPWDN,1,10),$E(PSJPRB,1,12),PPN,SD1IV,PST,$S(DRG'="NOT FOUND":$E(DRG,1,15),1:"zz")_"^"_PSJJORD_"V")=DRG_"^"_STD_"^"_MR_" "_SCH_" "_IR_"^"_ST_"^"_PR Q
|
|---|
| 82 | ;
|
|---|
| 83 | G S DIC="^PS(57.5,",DIC(0)="AEIMQZ" W ! D ^DIC K DIC W ! S:X="^OTHER" PSJMSG="^OTHER",PSGSS="C",Y(0,0)=2,Y=2 S WG=+Y S:+Y>0 PSJMSG=Y(0,0) Q
|
|---|
| 84 | W S DIC="^DIC(42,",DIC(0)="AEIMQZ",DIC("A")="Select WARD: " W ! D ^DIC K DIC S WD=+Y S:+Y>0 PSJMSG=Y(0,0) Q
|
|---|
| 85 | P D ENP^PSGGAO S Y=PSGP S:PSGP>0 PSJMSG=$P(PSGP(0),"^") Q
|
|---|
| 86 | DT S Y=-1 F W !!,"Enter ",D," date: " R X:DTIME W:'$T $C(7) S:'$T X="^" D DTM:X?1."?",^%DT:"^"'[X I Y>0!("^"[X) W:Y<0 !,"No ",D," date chosen for notices run." Q
|
|---|
| 87 | Q
|
|---|
| 88 | DTM W !!?2,"Enter the ",D," date of the range of dates to find orders about to expire.",!,"The start date and stop date may be the same." W:D="stop" " The stop date may not come before the start date." W ! Q
|
|---|
