- PSOORNE1 ;BIR/SAB - Display new orders from backdoor ;Jun 09, 2021@15:24:21
- ;;7.0;OUTPATIENT PHARMACY;**11,21,27,32,37,46,71,94,104,117,133,148,279,251,372,313,422,441**;DEC 1997;Build 208
- ;External reference to ^PS(55 is supported by DBIA 2228
- EN(PSONEW) D DSPL^PSOORNE3,^PSOLMPO2
- Q
- EDT N FLD,FIELDLST K DIR,DUOUT,DIRUT S DIR("A")="Select Field to Edit by number",DIR(0)="LO^1:14" D ^DIR I $D(DTOUT)!($D(DUOUT)) K DIR,DIRUT,DTOUT,DTOUT S VALMBCK="" Q
- EDTSEL S:'$G(COPY) PSOEDIT=1 S (PSONEW("DFLG"),PSONEW("FIELD"),PSONEW3)=0
- I +Y S FIELDLST=Y D HLDHDR^PSOLMUTL D Q:$G(PSORX("DFLG"))!($G(PSORX("QFLG"))) S VALMBCK="R" G DSPL^PSOORNE3
- .F FLD=1:1:$L(FIELDLST,",") Q:$P(FIELDLST,",",FLD)']"" D @(+$P(FIELDLST,",",FLD)) Q:$G(PSODIR("DFLG"))!($G(PSODIR("QFLG")))
- E S VALMBCK="" D FULL^VALM1
- D RDSPL G DSPL^PSOORNE3
- Q
- ACP K VALMSG,DIR,PSORX("DFLG") D VER I $G(PSONEW2("QFLG"))!($G(PSORX("DFLG"))) S VALMBCK="Q" K PSONEW2 Q
- N PSONOBCK S PSONOBCK=$S($G(PSOSIGFL):1,1:0)
- D NOOR^PSONEW I $D(DIRUT) S PSONEW("DFLG")=1 K DIR,X,Y,DIRUT,DUOUT,DTOUT Q
- D RXNCHK,RDSPL
- I $G(PSONEW("QFLG")) S PSONEW("DFLG")=1 K DIR,X,Y,DIRUT,DUOUT,DTOUT Q
- D DISPLAY^PSONEW2
- D ^PSONEWG I $G(PSOCPZ("DFLG")) S PSONEW("DFLG")=1 K PSOANSQ,DIR,X,Y,DIRUT,DUOUT,DTOUT,PSOCPZ("DFLG"),PSOANSQD Q
- K PSOCPZ("DFLG")
- K DIR,DIRUT,X,Y S DIR(0)="Y",DIR("B")="YES",DIR("A")="Is this correct" D ^DIR
- I $D(DIRUT) S PSONEW("DFLG")=1 K PSOANSQ,PSOANSQD,DIR,X,Y,DIRUT,DUOUT,DTOUT Q
- I 'Y S VALMBCK="R" K PSOANSQ,DIR,X,Y,DIRUT,DUOUT,DTOUT D DSPL^PSOORNE3 Q
- W "..." K PSOANSQD,DIR,X,Y,DIRUT,DUOUT,DTOUT D DCORD^PSONEW2
- I $G(NCPDPFLG) D NCPDP^PSOORED6
- K:$G(COPY)!($G(PSOSIGFL)) PRC,PHI
- S:'$G(PSOID) PSOID=DT S (PSORX("FN"),PSONEW("POE"))=1 D EN^PSON52(.PSONEW) ; Files entry in File 52
- ;
- ; - Possible Titration prescription
- I $G(PSONEW("IRXN")) D MARK^PSOOTMRX(PSONEW("IRXN"),0)
- ;
- I $G(PSOBEDT) D
- .I '$D(^TMP("PSOBEDT",$J,PSODFN,0)) S ^TMP("PSOBEDT",$J,PSODFN,0)=PSORXED("IRXN") S:$G(PSONEW("MAIL/WINDOW"))["W" ^TMP("PSOBEDT",$J,PSODFN,1)=1 Q
- .S ^TMP("PSOBEDT",$J,PSODFN,0)=^TMP("PSOBEDT",$J,PSODFN,0)_","_PSORXED("IRXN")
- .I $G(PSONEW("MAIL/WINDOW"))["W" S ^TMP("PSOBEDT",$J,PSODFN,1)=1
- D NPSOSD^PSOUTIL(.PSONEW) ; Adds newly added rx to PSOSD array
- D ^PSOBUILD S VALMBCK="Q"
- K PSONEW("# OF REFILLS"),PSONEW("DAYS SUPPLY"),SDA,SEG1,SSN1,STA,Z4,ZDA
- Q:$G(COPY) S PSONEW("DFLG")=0
- Q
- VER I $G(PSOAC),$G(PSODRUG("NAME"))']"" D FULL^VALM1,2^PSOORNW1
- I $G(PSODRUG("NAME"))']"" S VALMSG="A Dispense Drug Must be Chosen!" S PSONEW2("QFLG")=1 Q
- I '$G(PSONEW("ENT")) W !,"Dosing Instruction Missing!!",! D I PSONEW("DFLG")=1 S PSONEW2("QFLG")=1 Q
- .S PSOORRNW=1
- .K VALMSG D FULL^VALM1 W !,"Drug: "_PSODRUG("NAME")
- .I $O(SIG(0)) F I=1:1 Q:$G(SIG(I))']"" W !,SIG(I)
- .E I $G(^PSRX(PSONEW("OIRXN"),"SIG"))]"" S X=$P(^PSRX(PSONEW("OIRXN"),"SIG"),"^") D SIGONE^PSOHELP W !,$E($G(INS1),2,250)
- .W ! D 5 K PSOORRNW I PSONEW("DFLG")=1 D M3 Q
- .D 6 D:PSONEW("DFLG")=1 M3
- D:$G(COPY) PROV^PSOUTIL(.PSORENW) I $G(PSONEW("DFLG"))=1 S PSONEW2("QFLG")=1 Q
- N PSODOSD D FULL^VALM1,POST^PSODRG:'$G(PSOSIGFL)
- I $G(POERR("DFLG"))=1 S (PSONEW("DFLG"),PSONEW2("QFLG"))=1 Q
- I $G(PSODOSD) S (PSONEW("DFLG"),PSONEW2("QFLG"))=1 Q
- D:'$G(PSORX("DFLG")) DOSCK^PSODOSUT("N") K PSONOOR I $G(PSORX("DFLG")) S VALMBCK="Q" Q
- I +$G(PSEXDT) D
- .D FULL^VALM1 S:$G(PSONEW("MAIL/WINDOW"))["W" BINGCRT="Y",BINGRTE="W"
- .D:+$G(PSEXDT)
- ..S Y=PSONEW("FILL DATE") X ^DD("DD") W !!,$C(7),Y_" fill date is greater than possible expiration date of " S Y=$P(PSEXDT,"^",2) X ^DD("DD") W Y_"."
- .S PSONEW2("QFLG")=1,VALMBCK="R" D PAUSE^VALM1
- Q
- 1 I $G(PSOSIGFL)!$G(PSOMTFLG) D Q
- . S PSOAC=1 D 2^PSOORNW1 D:'$G(PSORX("DFLG")) 10^PSOBKDED,MW K PSOAC Q:$G(PSORX("DFLG")) D RDSPL D DSPL^PSOORNE3
- . I $G(PSOMTFLG),$G(PSORXED("DRUG IEN"))'=$G(PSODRUG("IEN")) D
- . . I FIELDLST'["5," D 5 Q:$G(PSODIR("DFLG"))!($G(PSODIR("QFLG")))
- . . I FIELDLST'["6," D 6 Q:$G(PSODIR("DFLG"))!($G(PSODIR("QFLG")))
- . . I FIELDLST'["8," D 8 Q:$G(PSODIR("DFLG"))!($G(PSODIR("QFLG")))
- ;
- D 6^PSOBKDED,MW
- D RDSPL G DSPL^PSOORNE3 Q
- ;
- MW I PSONEW("MAIL/WINDOW")="P",$G(PSODRUG("DEA"))["D" D
- .W !!,"This drug cannot be Parked! You must select a different routing!"
- .D 12^PSOBKDED
- Q
- ;
- 2 D 3^PSOBKDED Q
- ;
- 3 D 1^PSOBKDED Q
- ;
- 4 D 2^PSOBKDED Q
- ;
- 5 I '$G(PSODRUG("IEN")) W !,"DRUG NAME REQUIRED!" D 2^PSOORNW1 I '$G(PSODRUG("IEN")) S VALMSG="No Dispense Drug Selected" Q
- W !!,"Drug: "_PSODRUG("NAME") D 10^PSOBKDED Q
- ;
- 6 ;D INS^PSOBKDED Q:$G(PSONEW("DFLG")) I $P($G(^PS(55,PSODFN,"LAN")),"^") D SINS^PSODIR(.PSONEW) ;*422
- N PSOINSCH,PSODELINS
- S:'$D(PSOOEINS) PSOOEINS=$G(PSONEW("INS")) S:'$D(PSOOSINS) PSOOSINS=$G(PSONEW("SINS")) S:'$D(PSOOEIND) PSOOEIND=$G(PSONEW("IND")) S:'$D(PSOOINDF) PSOOEINDF=$G(PSONEW("INDF"))
- I '$P($G(^PS(55,PSODFN,"LAN")),"^") D INS^PSOBKDED Q:$G(PSONEW("DFLG"))
- I $P($G(^PS(55,PSODFN,"LAN")),"^") D
- .N PSODONE S (PSODONE,PSODELINS)=0
- .F D I PSODONE Q:$G(PSONEW("DFLG")) D SIND^PSODIR(.PSONEW) Q
- ..K PSONEW("DFLG")
- ..D INS^PSOBKDED
- ..I '$G(PSONEW("DFLG")),'PSODONE,'$G(PSODELINS) D SINS^PSODIR(.PSONEW)
- ..;POSS NOT NEEDED;I $G(PSONEW("DFLG")) S PSODONE=1,(PSONEW("SIG"),PSONEW("INS"))=$G(PSOOEINS),PSONEW("SINS")=$G(PSOOSINS) K PSONEW("SIG") D EN^PSOFSIG(.PSONEW,1) Q
- ..I $G(PSONEW("DFLG")) S (X,Y)=$G(PSONEW("INS")) D SIG^PSOHELP S (PSONEW("SIG",1),PSONEW("SIG"))=$E($G(INS1),2,9999999) K X,Y S PSODONE=1 Q
- ..S PSOINSCH=$$INSCHK^PSOHELP3(.PSONEW)
- ..I '$G(PSOINSCH) S PSODONE=1
- ;
- K PSOOEINS,PSOOSINS,PSOOEIND,PSOOEINDF
- Q
- ;
- 7 D 8^PSOBKDED Q
- ;
- 8 D 7^PSOBKDED Q
- ;
- 9 D 9^PSOBKDED Q
- ;
- 10 D 12^PSOBKDED Q
- ;
- 11 D 5^PSOBKDED Q
- ;
- 12 D 4^PSOBKDED Q
- ;
- 13 D 11^PSOBKDED Q
- ;
- 14 D 13^PSOBKDED Q
- ;
- 15 Q
- ;D 14^PSOBKDED Q
- ;
- SUMM ;print break down of orders to be finished
- K ^TMP($J,"PSOCZT"),^TMP($J,"PSODPAT"),PAT,RT,DIR,DUOUT,DIRUT,PSZLQUIT
- S DIR("A")="Do you want an Order Summary",DIR(0)="Y",DIR("B")="No"
- D ^DIR K DIR I 'Y!($D(DIRUT)) K Y,X,DIRUT Q
- K PSOINPRT,DIQ,^UTILITY("DIQ1",$J) I $G(PSOPINST) S DA=PSOPINST,DIC=4,DIQ(0)="E",DR=".01" D EN^DIQ1 S PSOINPRT=$G(^UTILITY("DIQ1",$J,4,DA,.01,"E")) K ^UTILITY("DIQ1",$J),DA,DR,DIC,DIQ
- I $D(^PS(52.41,"ACL")) N PSOCLSUM D SUMMCL I $G(PSOCLSUM) K PSOINPRT Q
- F PSI=0:0 S PSI=$O(^PS(52.41,"AOR",PSI)) Q:'PSI F PSID=0:0 S PSID=$O(^PS(52.41,"AOR",PSI,PSID)) Q:'PSID F PIN=0:0 S PIN=$O(^PS(52.41,"AOR",PSI,PSID,PIN)) Q:'PIN D
- .I '$D(^TMP($J,"PSOCZT",PSID,"PAT")) F PZA="PAT","WIN","MAIL","CLIN","PARK" S ^TMP($J,"PSOCZT",PSID,PZA)=0 ;441 PAPI
- .I '$D(^TMP($J,"PSODPAT",PSID,PSI)) S ^TMP($J,"PSODPAT",PSID,PSI)=1,^TMP($J,"PSOCZT",PSID,"PAT")=^TMP($J,"PSOCZT",PSID,"PAT")+1
- .;441 PAPI
- .S PZROUT=$P($G(^PS(52.41,PIN,0)),"^",17) I PZROUT'="" S ^TMP($J,"PSOCZT",PSID,$S(PZROUT="C":"CLIN",PZROUT="M":"MAIL",PZROUT="P":"PARK",1:"WIN"))=^TMP($J,"PSOCZT",PSID,$S(PZROUT="C":"CLIN",PZROUT="M":"MAIL",PZROUT="P":"PARK",1:"WIN"))+1
- W @IOF W !?20,"Pending Outpatient Medication Orders",! I $G(PSZCNT)>1 W ?20,"(signed in under "_$G(PSOINPRT)_")",!
- F PSOINL=0:0 S PSOINL=$O(^TMP($J,"PSOCZT",PSOINL)) Q:'PSOINL!($G(PSZLQUIT)) D
- .I ($Y+6)>IOSL K DIR S DIR(0)="E" D ^DIR K DIR D:$G(Y) I '$G(Y) S PSZLQUIT=1 W ! Q
- ..W @IOF W !?20,"Pending Outpatient Medication Orders",! I $G(PSZCNT)>1 W ?20,"(signed in under "_$G(PSOINPRT)_")",!
- .K ^UTILITY("DIQ1",$J),DIQ,PSOINPRX S DA=$G(PSOINL),DIC=4,DIQ(0)="E",DR=".01" D EN^DIQ1 S PSOINPRX=$G(^UTILITY("DIQ1",$J,4,DA,.01,"E")) K ^UTILITY("DIQ1",$J),DA,DR,DIC,DIQ
- .;PSO*7*279 Change division to Institution
- .W !,"Institution: ",$G(PSOINPRX)
- .W !,"Patients: "_$G(^TMP($J,"PSOCZT",PSOINL,"PAT"))_" Window: "_$G(^("WIN"))_" Mail: "_$G(^("MAIL"))_" Clinic: "_$G(^("CLIN"))_" Park: "_$G(^("PARK")),! ;441 PAPI
- K DIR S DIR(0)="E",(DIR("A"),DIR("?"))="Press Return to Continue" D ^DIR K DIR
- K ^TMP($J,"PSOCZT"),^TMP($J,"PSODPAT"),RT,PSOINPRT,PSOINPRX,PSI,PSID,PIN,PZA,PZROUT,PSOINL,PSZLQUIT
- Q
- SUMMCL ;
- ;PSO*7*279 Change Division to Institution
- W ! K DIR S DIR(0)="SMB^I:INSTITUTION;C:CLINIC",DIR("A")="Do you want the summary by Institution or Clinic",DIR("B")="Institution",DIR("?")=" "
- S DIR("?",1)="Enter 'I' to see the summary by Institution, and within Institution the orders",DIR("?",2)="shown by Mail, Window, or Administered in Clinic.",DIR("?",3)="Enter 'C' to see the summary by Clinic, along with Clinic Sort Groups."
- D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) S PSOCLSUM=1 Q
- Q:$G(Y)="I"
- S PSOCLSUM=1
- K ^TMP($J,"PSOLOC"),^TMP($J,"PSOLOCP") N PSCX,PSCXL,PSLX,PSCIN,PSCPT,PSCNDE,PSNCL,PSNPAT,PSCLOUT,PSCSFLAG,PCCNT,PSOCAG
- F PSCX=0:0 S PSCX=$O(^PS(52.41,"ACL",PSCX)) Q:'PSCX F PSLX=0:0 S PSLX=$O(^PS(52.41,"ACL",PSCX,PSLX)) Q:'PSLX F PSCIN=0:0 S PSCIN=$O(^PS(52.41,"ACL",PSCX,PSLX,PSCIN)) Q:'PSCIN S PSCPT=+$P($G(^PS(52.41,PSCIN,0)),"^",2) D:PSCPT
- .S PSCNDE=$G(^PS(52.41,PSCIN,0))
- .I $P(PSCNDE,"^",3)'="NW",$P(PSCNDE,"^",3)'="RNW",$P(PSCNDE,"^",3)'="RF" Q
- .I $P(PSCNDE,"^",13)="" Q
- .S PSNCL=+$P(PSCNDE,"^",13),PSNPAT=+$P(PSCNDE,"^",2)
- .I '$D(^TMP($J,"PSOLOC",PSNCL)) S ^TMP($J,"PSOLOC",PSNCL)="1^1",^TMP($J,"PSOLOCP",PSNCL,PSNPAT)="" Q
- .S $P(^TMP($J,"PSOLOC",PSNCL),"^",2)=$P(^TMP($J,"PSOLOC",PSNCL),"^",2)+1
- .I '$D(^TMP($J,"PSOLOCP",PSNCL,PSNPAT)) S $P(^TMP($J,"PSOLOC",PSNCL),"^")=$P(^TMP($J,"PSOLOC",PSNCL),"^")+1
- .S ^TMP($J,"PSOLOCP",PSNCL,PSNPAT)=""
- I '$O(^TMP($J,"PSOLOC",0)) G SUMMQ
- W @IOF W !?20,"Pending Outpatient Medication Orders" I $G(PSZCNT)>1 W !?20,"(signed in under "_$G(PSOINPRT)_")"
- F PSCXL=0:0 S PSCXL=$O(^TMP($J,"PSOLOC",PSCXL)) Q:'PSCXL!($G(PSCLOUT)) D
- .I ($Y+7)>IOSL D CLDIR Q:$G(PSCLOUT)
- .W !!,"Clinic: ",$P($G(^SC(+PSCXL,0)),"^")
- .W !,"Patients: ",$P($G(^TMP($J,"PSOLOC",PSCXL)),"^"),?16,"Orders: ",$P($G(^TMP($J,"PSOLOC",PSCXL)),"^",2)
- .W !,"In Sort Groups:"
- .S (PCCNT,PSCSFLAG)=0 F PSCSORT=0:0 S PSCSORT=$O(^PS(59.8,PSCSORT)) Q:'PSCSORT!($G(PSCLOUT)) I $D(^PS(59.8,PSCSORT,1,"B",PSCXL)) S PSOCAG=0 D
- ..S PSCSFLAG=1 S:($Y+5)>IOSL&(PCCNT) PSOCAG=1 D:($Y+5)>IOSL&(PCCNT) CLDIR Q:$G(PSCLOUT) W:$G(PSOCAG) !,"Clinic: "_$P($G(^SC(PSCXL,0)),"^")_" cont." W:$G(PCCNT)>0 ! W ?16,$P($G(^PS(59.8,PSCSORT,0)),"^") S PCCNT=1
- .I '$G(PSCSFLAG) W ?16,"*** NO CLINIC SORT GROUPS ***"
- I '$G(PSCLOUT) K DIR S DIR(0)="E",(DIR("A"),DIR("?"))="Press Return to continue" D ^DIR K DIR
- SUMMQ K ^TMP($J,"PSOLOC"),^TMP($J,"PSOLOCP")
- Q
- CLDIR K DIR S DIR(0)="E",(DIR("A"),DIR("?"))="Press Return to continue, '^' to exit" D ^DIR K DIR I Y'=1 S PSCLOUT=1 Q
- W @IOF
- Q
- RXNCHK I $G(PSONEW("RX #"))']"" D RXNCHK^PSOORNE5
- Q
- RDSPL D RDSPL^PSOORNE5
- Q
- M3 D M3^PSOOREDX
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOORNE1 10634 printed Jan 18, 2025@03:33:15 Page 2
- PSOORNE1 ;BIR/SAB - Display new orders from backdoor ;Jun 09, 2021@15:24:21
- +1 ;;7.0;OUTPATIENT PHARMACY;**11,21,27,32,37,46,71,94,104,117,133,148,279,251,372,313,422,441**;DEC 1997;Build 208
- +2 ;External reference to ^PS(55 is supported by DBIA 2228
- EN(PSONEW) DO DSPL^PSOORNE3
- DO ^PSOLMPO2
- +1 QUIT
- EDT NEW FLD,FIELDLST
- KILL DIR,DUOUT,DIRUT
- SET DIR("A")="Select Field to Edit by number"
- SET DIR(0)="LO^1:14"
- DO ^DIR
- IF $DATA(DTOUT)!($DATA(DUOUT))
- KILL DIR,DIRUT,DTOUT,DTOUT
- SET VALMBCK=""
- QUIT
- EDTSEL if '$GET(COPY)
- SET PSOEDIT=1
- SET (PSONEW("DFLG"),PSONEW("FIELD"),PSONEW3)=0
- +1 IF +Y
- SET FIELDLST=Y
- DO HLDHDR^PSOLMUTL
- Begin DoDot:1
- +2 FOR FLD=1:1:$LENGTH(FIELDLST,",")
- if $PIECE(FIELDLST,",",FLD)']""
- QUIT
- DO @(+$PIECE(FIELDLST,",",FLD))
- if $GET(PSODIR("DFLG"))!($GET(PSODIR("QFLG")))
- QUIT
- End DoDot:1
- if $GET(PSORX("DFLG"))!($GET(PSORX("QFLG")))
- QUIT
- SET VALMBCK="R"
- GOTO DSPL^PSOORNE3
- +3 IF '$TEST
- SET VALMBCK=""
- DO FULL^VALM1
- +4 DO RDSPL
- GOTO DSPL^PSOORNE3
- +5 QUIT
- ACP KILL VALMSG,DIR,PSORX("DFLG")
- DO VER
- IF $GET(PSONEW2("QFLG"))!($GET(PSORX("DFLG")))
- SET VALMBCK="Q"
- KILL PSONEW2
- QUIT
- +1 NEW PSONOBCK
- SET PSONOBCK=$SELECT($GET(PSOSIGFL):1,1:0)
- +2 DO NOOR^PSONEW
- IF $DATA(DIRUT)
- SET PSONEW("DFLG")=1
- KILL DIR,X,Y,DIRUT,DUOUT,DTOUT
- QUIT
- +3 DO RXNCHK
- DO RDSPL
- +4 IF $GET(PSONEW("QFLG"))
- SET PSONEW("DFLG")=1
- KILL DIR,X,Y,DIRUT,DUOUT,DTOUT
- QUIT
- +5 DO DISPLAY^PSONEW2
- +6 DO ^PSONEWG
- IF $GET(PSOCPZ("DFLG"))
- SET PSONEW("DFLG")=1
- KILL PSOANSQ,DIR,X,Y,DIRUT,DUOUT,DTOUT,PSOCPZ("DFLG"),PSOANSQD
- QUIT
- +7 KILL PSOCPZ("DFLG")
- +8 KILL DIR,DIRUT,X,Y
- SET DIR(0)="Y"
- SET DIR("B")="YES"
- SET DIR("A")="Is this correct"
- DO ^DIR
- +9 IF $DATA(DIRUT)
- SET PSONEW("DFLG")=1
- KILL PSOANSQ,PSOANSQD,DIR,X,Y,DIRUT,DUOUT,DTOUT
- QUIT
- +10 IF 'Y
- SET VALMBCK="R"
- KILL PSOANSQ,DIR,X,Y,DIRUT,DUOUT,DTOUT
- DO DSPL^PSOORNE3
- QUIT
- +11 WRITE "..."
- KILL PSOANSQD,DIR,X,Y,DIRUT,DUOUT,DTOUT
- DO DCORD^PSONEW2
- +12 IF $GET(NCPDPFLG)
- DO NCPDP^PSOORED6
- +13 if $GET(COPY)!($GET(PSOSIGFL))
- KILL PRC,PHI
- +14 ; Files entry in File 52
- if '$GET(PSOID)
- SET PSOID=DT
- SET (PSORX("FN"),PSONEW("POE"))=1
- DO EN^PSON52(.PSONEW)
- +15 ;
- +16 ; - Possible Titration prescription
- +17 IF $GET(PSONEW("IRXN"))
- DO MARK^PSOOTMRX(PSONEW("IRXN"),0)
- +18 ;
- +19 IF $GET(PSOBEDT)
- Begin DoDot:1
- +20 IF '$DATA(^TMP("PSOBEDT",$JOB,PSODFN,0))
- SET ^TMP("PSOBEDT",$JOB,PSODFN,0)=PSORXED("IRXN")
- if $GET(PSONEW("MAIL/WINDOW"))["W"
- SET ^TMP("PSOBEDT",$JOB,PSODFN,1)=1
- QUIT
- +21 SET ^TMP("PSOBEDT",$JOB,PSODFN,0)=^TMP("PSOBEDT",$JOB,PSODFN,0)_","_PSORXED("IRXN")
- +22 IF $GET(PSONEW("MAIL/WINDOW"))["W"
- SET ^TMP("PSOBEDT",$JOB,PSODFN,1)=1
- End DoDot:1
- +23 ; Adds newly added rx to PSOSD array
- DO NPSOSD^PSOUTIL(.PSONEW)
- +24 DO ^PSOBUILD
- SET VALMBCK="Q"
- +25 KILL PSONEW("# OF REFILLS"),PSONEW("DAYS SUPPLY"),SDA,SEG1,SSN1,STA,Z4,ZDA
- +26 if $GET(COPY)
- QUIT
- SET PSONEW("DFLG")=0
- +27 QUIT
- VER IF $GET(PSOAC)
- IF $GET(PSODRUG("NAME"))']""
- DO FULL^VALM1
- DO 2^PSOORNW1
- +1 IF $GET(PSODRUG("NAME"))']""
- SET VALMSG="A Dispense Drug Must be Chosen!"
- SET PSONEW2("QFLG")=1
- QUIT
- +2 IF '$GET(PSONEW("ENT"))
- WRITE !,"Dosing Instruction Missing!!",!
- Begin DoDot:1
- +3 SET PSOORRNW=1
- +4 KILL VALMSG
- DO FULL^VALM1
- WRITE !,"Drug: "_PSODRUG("NAME")
- +5 IF $ORDER(SIG(0))
- FOR I=1:1
- if $GET(SIG(I))']""
- QUIT
- WRITE !,SIG(I)
- +6 IF '$TEST
- IF $GET(^PSRX(PSONEW("OIRXN"),"SIG"))]""
- SET X=$PIECE(^PSRX(PSONEW("OIRXN"),"SIG"),"^")
- DO SIGONE^PSOHELP
- WRITE !,$EXTRACT($GET(INS1),2,250)
- +7 WRITE !
- DO 5
- KILL PSOORRNW
- IF PSONEW("DFLG")=1
- DO M3
- QUIT
- +8 DO 6
- if PSONEW("DFLG")=1
- DO M3
- End DoDot:1
- IF PSONEW("DFLG")=1
- SET PSONEW2("QFLG")=1
- QUIT
- +9 if $GET(COPY)
- DO PROV^PSOUTIL(.PSORENW)
- IF $GET(PSONEW("DFLG"))=1
- SET PSONEW2("QFLG")=1
- QUIT
- +10 NEW PSODOSD
- DO FULL^VALM1
- if '$GET(PSOSIGFL)
- DO POST^PSODRG
- +11 IF $GET(POERR("DFLG"))=1
- SET (PSONEW("DFLG"),PSONEW2("QFLG"))=1
- QUIT
- +12 IF $GET(PSODOSD)
- SET (PSONEW("DFLG"),PSONEW2("QFLG"))=1
- QUIT
- +13 if '$GET(PSORX("DFLG"))
- DO DOSCK^PSODOSUT("N")
- KILL PSONOOR
- IF $GET(PSORX("DFLG"))
- SET VALMBCK="Q"
- QUIT
- +14 IF +$GET(PSEXDT)
- Begin DoDot:1
- +15 DO FULL^VALM1
- if $GET(PSONEW("MAIL/WINDOW"))["W"
- SET BINGCRT="Y"
- SET BINGRTE="W"
- +16 if +$GET(PSEXDT)
- Begin DoDot:2
- +17 SET Y=PSONEW("FILL DATE")
- XECUTE ^DD("DD")
- WRITE !!,$CHAR(7),Y_" fill date is greater than possible expiration date of "
- SET Y=$PIECE(PSEXDT,"^",2)
- XECUTE ^DD("DD")
- WRITE Y_"."
- End DoDot:2
- +18 SET PSONEW2("QFLG")=1
- SET VALMBCK="R"
- DO PAUSE^VALM1
- End DoDot:1
- +19 QUIT
- 1 IF $GET(PSOSIGFL)!$GET(PSOMTFLG)
- Begin DoDot:1
- +1 SET PSOAC=1
- DO 2^PSOORNW1
- if '$GET(PSORX("DFLG"))
- DO 10^PSOBKDED
- DO MW
- KILL PSOAC
- if $GET(PSORX("DFLG"))
- QUIT
- DO RDSPL
- DO DSPL^PSOORNE3
- +2 IF $GET(PSOMTFLG)
- IF $GET(PSORXED("DRUG IEN"))'=$GET(PSODRUG("IEN"))
- Begin DoDot:2
- +3 IF FIELDLST'["5,"
- DO 5
- if $GET(PSODIR("DFLG"))!($GET(PSODIR("QFLG")))
- QUIT
- +4 IF FIELDLST'["6,"
- DO 6
- if $GET(PSODIR("DFLG"))!($GET(PSODIR("QFLG")))
- QUIT
- +5 IF FIELDLST'["8,"
- DO 8
- if $GET(PSODIR("DFLG"))!($GET(PSODIR("QFLG")))
- QUIT
- End DoDot:2
- End DoDot:1
- QUIT
- +6 ;
- +7 DO 6^PSOBKDED
- DO MW
- +8 DO RDSPL
- GOTO DSPL^PSOORNE3
- QUIT
- +9 ;
- MW IF PSONEW("MAIL/WINDOW")="P"
- IF $GET(PSODRUG("DEA"))["D"
- Begin DoDot:1
- +1 WRITE !!,"This drug cannot be Parked! You must select a different routing!"
- +2 DO 12^PSOBKDED
- End DoDot:1
- +3 QUIT
- +4 ;
- 2 DO 3^PSOBKDED
- QUIT
- +1 ;
- 3 DO 1^PSOBKDED
- QUIT
- +1 ;
- 4 DO 2^PSOBKDED
- QUIT
- +1 ;
- 5 IF '$GET(PSODRUG("IEN"))
- WRITE !,"DRUG NAME REQUIRED!"
- DO 2^PSOORNW1
- IF '$GET(PSODRUG("IEN"))
- SET VALMSG="No Dispense Drug Selected"
- QUIT
- +1 WRITE !!,"Drug: "_PSODRUG("NAME")
- DO 10^PSOBKDED
- QUIT
- +2 ;
- 6 ;D INS^PSOBKDED Q:$G(PSONEW("DFLG")) I $P($G(^PS(55,PSODFN,"LAN")),"^") D SINS^PSODIR(.PSONEW) ;*422
- +1 NEW PSOINSCH,PSODELINS
- +2 if '$DATA(PSOOEINS)
- SET PSOOEINS=$GET(PSONEW("INS"))
- if '$DATA(PSOOSINS)
- SET PSOOSINS=$GET(PSONEW("SINS"))
- if '$DATA(PSOOEIND)
- SET PSOOEIND=$GET(PSONEW("IND"))
- if '$DATA(PSOOINDF)
- SET PSOOEINDF=$GET(PSONEW("INDF"))
- +3 IF '$PIECE($GET(^PS(55,PSODFN,"LAN")),"^")
- DO INS^PSOBKDED
- if $GET(PSONEW("DFLG"))
- QUIT
- +4 IF $PIECE($GET(^PS(55,PSODFN,"LAN")),"^")
- Begin DoDot:1
- +5 NEW PSODONE
- SET (PSODONE,PSODELINS)=0
- +6 FOR
- Begin DoDot:2
- +7 KILL PSONEW("DFLG")
- +8 DO INS^PSOBKDED
- +9 IF '$GET(PSONEW("DFLG"))
- IF 'PSODONE
- IF '$GET(PSODELINS)
- DO SINS^PSODIR(.PSONEW)
- +10 ;POSS NOT NEEDED;I $G(PSONEW("DFLG")) S PSODONE=1,(PSONEW("SIG"),PSONEW("INS"))=$G(PSOOEINS),PSONEW("SINS")=$G(PSOOSINS) K PSONEW("SIG") D EN^PSOFSIG(.PSONEW,1) Q
- +11 IF $GET(PSONEW("DFLG"))
- SET (X,Y)=$GET(PSONEW("INS"))
- DO SIG^PSOHELP
- SET (PSONEW("SIG",1),PSONEW("SIG"))=$EXTRACT($GET(INS1),2,9999999)
- KILL X,Y
- SET PSODONE=1
- QUIT
- +12 SET PSOINSCH=$$INSCHK^PSOHELP3(.PSONEW)
- +13 IF '$GET(PSOINSCH)
- SET PSODONE=1
- End DoDot:2
- IF PSODONE
- if $GET(PSONEW("DFLG"))
- QUIT
- DO SIND^PSODIR(.PSONEW)
- QUIT
- End DoDot:1
- +14 ;
- +15 KILL PSOOEINS,PSOOSINS,PSOOEIND,PSOOEINDF
- +16 QUIT
- +17 ;
- 7 DO 8^PSOBKDED
- QUIT
- +1 ;
- 8 DO 7^PSOBKDED
- QUIT
- +1 ;
- 9 DO 9^PSOBKDED
- QUIT
- +1 ;
- 10 DO 12^PSOBKDED
- QUIT
- +1 ;
- 11 DO 5^PSOBKDED
- QUIT
- +1 ;
- 12 DO 4^PSOBKDED
- QUIT
- +1 ;
- 13 DO 11^PSOBKDED
- QUIT
- +1 ;
- 14 DO 13^PSOBKDED
- QUIT
- +1 ;
- 15 QUIT
- +1 ;D 14^PSOBKDED Q
- +2 ;
- SUMM ;print break down of orders to be finished
- +1 KILL ^TMP($JOB,"PSOCZT"),^TMP($JOB,"PSODPAT"),PAT,RT,DIR,DUOUT,DIRUT,PSZLQUIT
- +2 SET DIR("A")="Do you want an Order Summary"
- SET DIR(0)="Y"
- SET DIR("B")="No"
- +3 DO ^DIR
- KILL DIR
- IF 'Y!($DATA(DIRUT))
- KILL Y,X,DIRUT
- QUIT
- +4 KILL PSOINPRT,DIQ,^UTILITY("DIQ1",$JOB)
- IF $GET(PSOPINST)
- SET DA=PSOPINST
- SET DIC=4
- SET DIQ(0)="E"
- SET DR=".01"
- DO EN^DIQ1
- SET PSOINPRT=$GET(^UTILITY("DIQ1",$JOB,4,DA,.01,"E"))
- KILL ^UTILITY("DIQ1",$JOB),DA,DR,DIC,DIQ
- +5 IF $DATA(^PS(52.41,"ACL"))
- NEW PSOCLSUM
- DO SUMMCL
- IF $GET(PSOCLSUM)
- KILL PSOINPRT
- QUIT
- +6 FOR PSI=0:0
- SET PSI=$ORDER(^PS(52.41,"AOR",PSI))
- if 'PSI
- QUIT
- FOR PSID=0:0
- SET PSID=$ORDER(^PS(52.41,"AOR",PSI,PSID))
- if 'PSID
- QUIT
- FOR PIN=0:0
- SET PIN=$ORDER(^PS(52.41,"AOR",PSI,PSID,PIN))
- if 'PIN
- QUIT
- Begin DoDot:1
- +7 ;441 PAPI
- IF '$DATA(^TMP($JOB,"PSOCZT",PSID,"PAT"))
- FOR PZA="PAT","WIN","MAIL","CLIN","PARK"
- SET ^TMP($JOB,"PSOCZT",PSID,PZA)=0
- +8 IF '$DATA(^TMP($JOB,"PSODPAT",PSID,PSI))
- SET ^TMP($JOB,"PSODPAT",PSID,PSI)=1
- SET ^TMP($JOB,"PSOCZT",PSID,"PAT")=^TMP($JOB,"PSOCZT",PSID,"PAT")+1
- +9 ;441 PAPI
- +10 SET PZROUT=$PIECE($GET(^PS(52.41,PIN,0)),"^",17)
- IF PZROUT'=""
- SET ^TMP($JOB,"PSOCZT",PSID,$SELECT(PZROUT="C":"CLIN",PZROUT="M":"MAIL",PZROUT="P":"PARK",1:"WIN"))=^TMP($JOB,"PSOCZT",PSID,$SELECT(PZROUT="C":"CLIN",PZROUT="M":"MAIL",PZROUT="P":"PARK",1:"WIN"))+1
- End DoDot:1
- +11 WRITE @IOF
- WRITE !?20,"Pending Outpatient Medication Orders",!
- IF $GET(PSZCNT)>1
- WRITE ?20,"(signed in under "_$GET(PSOINPRT)_")",!
- +12 FOR PSOINL=0:0
- SET PSOINL=$ORDER(^TMP($JOB,"PSOCZT",PSOINL))
- if 'PSOINL!($GET(PSZLQUIT))
- QUIT
- Begin DoDot:1
- +13 IF ($Y+6)>IOSL
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- if $GET(Y)
- Begin DoDot:2
- +14 WRITE @IOF
- WRITE !?20,"Pending Outpatient Medication Orders",!
- IF $GET(PSZCNT)>1
- WRITE ?20,"(signed in under "_$GET(PSOINPRT)_")",!
- End DoDot:2
- IF '$GET(Y)
- SET PSZLQUIT=1
- WRITE !
- QUIT
- +15 KILL ^UTILITY("DIQ1",$JOB),DIQ,PSOINPRX
- SET DA=$GET(PSOINL)
- SET DIC=4
- SET DIQ(0)="E"
- SET DR=".01"
- DO EN^DIQ1
- SET PSOINPRX=$GET(^UTILITY("DIQ1",$JOB,4,DA,.01,"E"))
- KILL ^UTILITY("DIQ1",$JOB),DA,DR,DIC,DIQ
- +16 ;PSO*7*279 Change division to Institution
- +17 WRITE !,"Institution: ",$GET(PSOINPRX)
- +18 ;441 PAPI
- WRITE !,"Patients: "_$GET(^TMP($JOB,"PSOCZT",PSOINL,"PAT"))_" Window: "_$GET(^("WIN"))_" Mail: "_$GET(^("MAIL"))_" Clinic: "_$GET(^("CLIN"))_" Park: "_$GET(^("PARK")),!
- End DoDot:1
- +19 KILL DIR
- SET DIR(0)="E"
- SET (DIR("A"),DIR("?"))="Press Return to Continue"
- DO ^DIR
- KILL DIR
- +20 KILL ^TMP($JOB,"PSOCZT"),^TMP($JOB,"PSODPAT"),RT,PSOINPRT,PSOINPRX,PSI,PSID,PIN,PZA,PZROUT,PSOINL,PSZLQUIT
- +21 QUIT
- SUMMCL ;
- +1 ;PSO*7*279 Change Division to Institution
- +2 WRITE !
- KILL DIR
- SET DIR(0)="SMB^I:INSTITUTION;C:CLINIC"
- SET DIR("A")="Do you want the summary by Institution or Clinic"
- SET DIR("B")="Institution"
- SET DIR("?")=" "
- +3 SET DIR("?",1)="Enter 'I' to see the summary by Institution, and within Institution the orders"
- SET DIR("?",2)="shown by Mail, Window, or Administered in Clinic."
- SET DIR("?",3)="Enter 'C' to see the summary by Clinic, along with Clinic Sort Groups."
- +4 DO ^DIR
- KILL DIR
- IF $DATA(DTOUT)!($DATA(DUOUT))
- SET PSOCLSUM=1
- QUIT
- +5 if $GET(Y)="I"
- QUIT
- +6 SET PSOCLSUM=1
- +7 KILL ^TMP($JOB,"PSOLOC"),^TMP($JOB,"PSOLOCP")
- NEW PSCX,PSCXL,PSLX,PSCIN,PSCPT,PSCNDE,PSNCL,PSNPAT,PSCLOUT,PSCSFLAG,PCCNT,PSOCAG
- +8 FOR PSCX=0:0
- SET PSCX=$ORDER(^PS(52.41,"ACL",PSCX))
- if 'PSCX
- QUIT
- FOR PSLX=0:0
- SET PSLX=$ORDER(^PS(52.41,"ACL",PSCX,PSLX))
- if 'PSLX
- QUIT
- FOR PSCIN=0:0
- SET PSCIN=$ORDER(^PS(52.41,"ACL",PSCX,PSLX,PSCIN))
- if 'PSCIN
- QUIT
- SET PSCPT=+$PIECE($GET(^PS(52.41,PSCIN,0)),"^",2)
- if PSCPT
- Begin DoDot:1
- +9 SET PSCNDE=$GET(^PS(52.41,PSCIN,0))
- +10 IF $PIECE(PSCNDE,"^",3)'="NW"
- IF $PIECE(PSCNDE,"^",3)'="RNW"
- IF $PIECE(PSCNDE,"^",3)'="RF"
- QUIT
- +11 IF $PIECE(PSCNDE,"^",13)=""
- QUIT
- +12 SET PSNCL=+$PIECE(PSCNDE,"^",13)
- SET PSNPAT=+$PIECE(PSCNDE,"^",2)
- +13 IF '$DATA(^TMP($JOB,"PSOLOC",PSNCL))
- SET ^TMP($JOB,"PSOLOC",PSNCL)="1^1"
- SET ^TMP($JOB,"PSOLOCP",PSNCL,PSNPAT)=""
- QUIT
- +14 SET $PIECE(^TMP($JOB,"PSOLOC",PSNCL),"^",2)=$PIECE(^TMP($JOB,"PSOLOC",PSNCL),"^",2)+1
- +15 IF '$DATA(^TMP($JOB,"PSOLOCP",PSNCL,PSNPAT))
- SET $PIECE(^TMP($JOB,"PSOLOC",PSNCL),"^")=$PIECE(^TMP($JOB,"PSOLOC",PSNCL),"^")+1
- +16 SET ^TMP($JOB,"PSOLOCP",PSNCL,PSNPAT)=""
- End DoDot:1
- +17 IF '$ORDER(^TMP($JOB,"PSOLOC",0))
- GOTO SUMMQ
- +18 WRITE @IOF
- WRITE !?20,"Pending Outpatient Medication Orders"
- IF $GET(PSZCNT)>1
- WRITE !?20,"(signed in under "_$GET(PSOINPRT)_")"
- +19 FOR PSCXL=0:0
- SET PSCXL=$ORDER(^TMP($JOB,"PSOLOC",PSCXL))
- if 'PSCXL!($GET(PSCLOUT))
- QUIT
- Begin DoDot:1
- +20 IF ($Y+7)>IOSL
- DO CLDIR
- if $GET(PSCLOUT)
- QUIT
- +21 WRITE !!,"Clinic: ",$PIECE($GET(^SC(+PSCXL,0)),"^")
- +22 WRITE !,"Patients: ",$PIECE($GET(^TMP($JOB,"PSOLOC",PSCXL)),"^"),?16,"Orders: ",$PIECE($GET(^TMP($JOB,"PSOLOC",PSCXL)),"^",2)
- +23 WRITE !,"In Sort Groups:"
- +24 SET (PCCNT,PSCSFLAG)=0
- FOR PSCSORT=0:0
- SET PSCSORT=$ORDER(^PS(59.8,PSCSORT))
- if 'PSCSORT!($GET(PSCLOUT))
- QUIT
- IF $DATA(^PS(59.8,PSCSORT,1,"B",PSCXL))
- SET PSOCAG=0
- Begin DoDot:2
- +25 SET PSCSFLAG=1
- if ($Y+5)>IOSL&(PCCNT)
- SET PSOCAG=1
- if ($Y+5)>IOSL&(PCCNT)
- DO CLDIR
- if $GET(PSCLOUT)
- QUIT
- if $GET(PSOCAG)
- WRITE !,"Clinic: "_$PIECE($GET(^SC(PSCXL,0)),"^")_" cont."
- if $GET(PCCNT)>0
- WRITE !
- WRITE ?16,$PIECE($GET(^PS(59.8,PSCSORT,0)),"^")
- SET PCCNT=1
- End DoDot:2
- +26 IF '$GET(PSCSFLAG)
- WRITE ?16,"*** NO CLINIC SORT GROUPS ***"
- End DoDot:1
- +27 IF '$GET(PSCLOUT)
- KILL DIR
- SET DIR(0)="E"
- SET (DIR("A"),DIR("?"))="Press Return to continue"
- DO ^DIR
- KILL DIR
- SUMMQ KILL ^TMP($JOB,"PSOLOC"),^TMP($JOB,"PSOLOCP")
- +1 QUIT
- CLDIR KILL DIR
- SET DIR(0)="E"
- SET (DIR("A"),DIR("?"))="Press Return to continue, '^' to exit"
- DO ^DIR
- KILL DIR
- IF Y'=1
- SET PSCLOUT=1
- QUIT
- +1 WRITE @IOF
- +2 QUIT
- RXNCHK IF $GET(PSONEW("RX #"))']""
- DO RXNCHK^PSOORNE5
- +1 QUIT
- RDSPL DO RDSPL^PSOORNE5
- +1 QUIT
- M3 DO M3^PSOOREDX
- +1 QUIT