Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed

  • WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOORNE1.m

    r613 r623  
    1 PSOORNE1        ;BIR/SAB - Display new orders from backdoor ; 2/14/08 10:30am
    2         ;;7.0;OUTPATIENT PHARMACY;**11,21,27,32,37,46,71,94,104,117,133,148,279**;DEC 1997;Build 9
    3         ;External reference to ^PS(55 is supported by DBIA 2228
    4 EN(PSONEW)      D DSPL^PSOORNE3,^PSOLMPO2
    5         Q
    6 EDT     N FLD,LST 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
    7 EDTSEL  S:'$G(COPY) PSOEDIT=1 S (PSONEW("DFLG"),PSONEW("FIELD"),PSONEW3)=0
    8         I +Y S LST=Y D HLDHDR^PSOLMUTL D  Q:$G(PSORX("DFLG"))!($G(PSORX("QFLG")))  S VALMBCK="R" G DSPL^PSOORNE3
    9         .F FLD=1:1:$L(LST,",") Q:$P(LST,",",FLD)']""  D @(+$P(LST,",",FLD)) Q:$G(PSODIR("DFLG"))!($G(PSODIR("QFLG")))
    10         E  S VALMBCK="" D FULL^VALM1
    11         D RDSPL G DSPL^PSOORNE3
    12         Q
    13 ACP     K VALMSG,DIR,PSORX("DFLG") D VER I $G(PSONEW2("QFLG"))!($G(PSORX("DFLG"))) S VALMBCK="Q" K PSONEW2 Q
    14         N PSONOBCK S PSONOBCK=$S($G(PSOSIGFL):1,1:0)
    15         D NOOR^PSONEW I $D(DIRUT) S PSONEW("DFLG")=1 K DIR,X,Y,DIRUT,DUOUT,DTOUT Q
    16         D RXNCHK,RDSPL
    17         I $G(PSONEW("QFLG")) S PSONEW("DFLG")=1 K DIR,X,Y,DIRUT,DUOUT,DTOUT Q
    18         D DISPLAY^PSONEW2
    19         D ^PSONEWG I $G(PSOCPZ("DFLG")) S PSONEW("DFLG")=1 K PSOANSQ,DIR,X,Y,DIRUT,DUOUT,DTOUT,PSOCPZ("DFLG"),PSOANSQD Q
    20         K PSOCPZ("DFLG")
    21         K DIR,DIRUT,X,Y S DIR(0)="Y",DIR("B")="YES",DIR("A")="Is this correct" D ^DIR
    22         I $D(DIRUT) S PSONEW("DFLG")=1 K PSOANSQ,PSOANSQD,DIR,X,Y,DIRUT,DUOUT,DTOUT Q
    23         I 'Y S VALMBCK="R" K PSOANSQ,DIR,X,Y,DIRUT,DUOUT,DTOUT D DSPL^PSOORNE3 Q
    24         W "..." K PSOANSQD,DIR,X,Y,DIRUT,DUOUT,DTOUT D DCORD^PSONEW2
    25         I $G(NCPDPFLG) D NCPDP^PSOORED6
    26         K:$G(COPY)!($G(PSOSIGFL)) PRC,PHI
    27         S:'$G(PSOID) PSOID=DT S (PSORX("FN"),PSONEW("POE"))=1 D EN^PSON52(.PSONEW) ; Files entry in File 52
    28         I $G(PSOBEDT) D
    29         .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
    30         .S ^TMP("PSOBEDT",$J,PSODFN,0)=^TMP("PSOBEDT",$J,PSODFN,0)_","_PSORXED("IRXN")
    31         .I $G(PSONEW("MAIL/WINDOW"))["W" S ^TMP("PSOBEDT",$J,PSODFN,1)=1
    32         D NPSOSD^PSOUTIL(.PSONEW) ; Adds newly added rx to PSOSD array
    33         D ^PSOBUILD S VALMBCK="Q"
    34         K PSONEW("# OF REFILLS"),PSONEW("DAYS SUPPLY"),SDA,SEG1,SSN1,STA,Z4,ZDA
    35         Q:$G(COPY)  S PSONEW("DFLG")=0
    36         Q
    37 VER     I $G(PSOAC),$G(PSODRUG("NAME"))']"" D FULL^VALM1,2^PSOORNW1
    38         I $G(PSODRUG("NAME"))']"" S VALMSG="A Dispense Drug Must be Chosen!" S PSONEW2("QFLG")=1 Q
    39         I '$G(PSONEW("ENT")) W !,"Dosing Instruction Missing!!",! D  I PSONEW("DFLG")=1 S PSONEW2("QFLG")=1 Q
    40         .S PSOORRNW=1
    41         .K VALMSG D FULL^VALM1 W !,"Drug: "_PSODRUG("NAME")
    42         .I $O(SIG(0)) F I=1:1 Q:$G(SIG(I))']""  W !,SIG(I)
    43         .E   I $G(^PSRX(PSONEW("OIRXN"),"SIG"))]"" S X=$P(^PSRX(PSONEW("OIRXN"),"SIG"),"^") D SIGONE^PSOHELP W !,$E($G(INS1),2,250)
    44         .W ! D 5 K PSOORRNW I PSONEW("DFLG")=1 D M3 Q
    45         .D 6 D:PSONEW("DFLG")=1 M3
    46         D:$G(COPY) PROV^PSOUTIL(.PSORENW) I PSONEW("DFLG")=1 S PSONEW2("QFLG")=1 Q
    47         D FULL^VALM1,POST^PSODRG:'$G(PSOSIGFL) K PSONOOR I $G(PSORX("DFLG")) S VALMBCK="Q" Q
    48         I +$G(PSEXDT) D
    49         .D FULL^VALM1 S:$G(PSONEW("MAIL/WINDOW"))["W" BINGCRT="Y",BINGRTE="W"
    50         .D:+$G(PSEXDT)
    51         ..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_"."
    52         .S PSONEW2("QFLG")=1,VALMBCK="R" D PAUSE^VALM1
    53         Q
    54 1       I $G(PSOSIGFL) S PSOAC=1 D 2^PSOORNW1 K PSOAC D RDSPL G DSPL^PSOORNE3 Q
    55         D 6^PSOBKDED D RDSPL G DSPL^PSOORNE3 Q
    56         ;
    57 2       D 3^PSOBKDED Q
    58         ;
    59 3       D 1^PSOBKDED Q
    60         ;
    61 4       D 2^PSOBKDED Q
    62         ;
    63 5       I '$G(PSODRUG("IEN")) W !,"DRUG NAME REQUIRED!" D 2^PSOORNW1 I '$G(PSODRUG("IEN")) S VALMSG="No Dispense Drug Selected" Q
    64         W !!,"Drug: "_PSODRUG("NAME") D 10^PSOBKDED Q
    65         ;
    66 6       D INS^PSOBKDED Q:$G(PSONEW("DFLG"))  I $P($G(^PS(55,PSODFN,"LAN")),"^") D SINS^PSODIR(.PSONEW)
    67         Q
    68         ;
    69 7       D 8^PSOBKDED Q
    70         ;
    71 8       D 7^PSOBKDED Q
    72         ;
    73 9       D 9^PSOBKDED Q
    74         ;
    75 10      D 12^PSOBKDED Q
    76         ;
    77 11      D 5^PSOBKDED Q
    78         ;
    79 12      D 4^PSOBKDED Q
    80         ;
    81 13      D 11^PSOBKDED Q
    82         ;
    83 14      D 13^PSOBKDED Q
    84         ;
    85 SUMM    ;print break down of orders to be finished
    86         K ^TMP($J,"PSOCZT"),^TMP($J,"PSODPAT"),PAT,RT,DIR,DUOUT,DIRUT,PSZLQUIT
    87         S DIR("A")="Do you want an Order Summary",DIR(0)="Y",DIR("B")="No"
    88         D ^DIR K DIR I 'Y!($D(DIRUT)) K Y,X,DIRUT Q
    89         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
    90         I $D(^PS(52.41,"ACL")) N PSOCLSUM D SUMMCL I $G(PSOCLSUM) K PSOINPRT Q
    91         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
    92         .I '$D(^TMP($J,"PSOCZT",PSID,"PAT")) F PZA="PAT","WIN","MAIL","CLIN" S ^TMP($J,"PSOCZT",PSID,PZA)=0
    93         .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
    94         .S PZROUT=$P($G(^PS(52.41,PIN,0)),"^",17) I PZROUT'="" S ^TMP($J,"PSOCZT",PSID,$S(PZROUT="C":"CLIN",PZROUT="M":"MAIL",1:"WIN"))=^TMP($J,"PSOCZT",PSID,$S(PZROUT="C":"CLIN",PZROUT="M":"MAIL",1:"WIN"))+1
    95         W @IOF W !?20,"Pending Outpatient Medication Orders",! I $G(PSZCNT)>1 W ?20,"(signed in under "_$G(PSOINPRT)_")",!
    96         F PSOINL=0:0 S PSOINL=$O(^TMP($J,"PSOCZT",PSOINL)) Q:'PSOINL!($G(PSZLQUIT))  D
    97         .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
    98         ..W @IOF W !?20,"Pending Outpatient Medication Orders",! I $G(PSZCNT)>1 W ?20,"(signed in under "_$G(PSOINPRT)_")",!
    99         .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
    100         .;PSO*7*279 Change division to Institution
    101         .W !,"Institution: ",$G(PSOINPRX)
    102         .W !,"Patients: "_$G(^TMP($J,"PSOCZT",PSOINL,"PAT"))_"  Window: "_$G(^("WIN"))_"  Mail: "_$G(^("MAIL"))_"  Clinic: "_$G(^("CLIN")),!
    103         K DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIR
    104         K ^TMP($J,"PSOCZT"),^TMP($J,"PSODPAT"),RT,PSOINPRT,PSOINPRX,PSI,PSID,PIN,PZA,PZROUT,PSOINL,PSZLQUIT
    105         Q
    106 SUMMCL  ;
    107         ;PSO*7*279 Change Division to Institution
    108         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("?")=" "
    109         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."
    110         D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) S PSOCLSUM=1 Q
    111         Q:$G(Y)="I"
    112         S PSOCLSUM=1
    113         K ^TMP($J,"PSOLOC"),^TMP($J,"PSOLOCP") N PSCX,PSCXL,PSLX,PSCIN,PSCPT,PSCNDE,PSNCL,PSNPAT,PSCLOUT,PSCSFLAG,PCCNT,PSOCAG
    114         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
    115         .S PSCNDE=$G(^PS(52.41,PSCIN,0))
    116         .I $P(PSCNDE,"^",3)'="NW",$P(PSCNDE,"^",3)'="RNW",$P(PSCNDE,"^",3)'="RF" Q
    117         .I $P(PSCNDE,"^",13)="" Q
    118         .S PSNCL=+$P(PSCNDE,"^",13),PSNPAT=+$P(PSCNDE,"^",2)
    119         .I '$D(^TMP($J,"PSOLOC",PSNCL)) S ^TMP($J,"PSOLOC",PSNCL)="1^1",^TMP($J,"PSOLOCP",PSNCL,PSNPAT)="" Q
    120         .S $P(^TMP($J,"PSOLOC",PSNCL),"^",2)=$P(^TMP($J,"PSOLOC",PSNCL),"^",2)+1
    121         .I '$D(^TMP($J,"PSOLOCP",PSNCL,PSNPAT)) S $P(^TMP($J,"PSOLOC",PSNCL),"^")=$P(^TMP($J,"PSOLOC",PSNCL),"^")+1
    122         .S ^TMP($J,"PSOLOCP",PSNCL,PSNPAT)=""
    123         I '$O(^TMP($J,"PSOLOC",0)) G SUMMQ
    124         W @IOF W !?20,"Pending Outpatient Medication Orders" I $G(PSZCNT)>1 W !?20,"(signed in under "_$G(PSOINPRT)_")"
    125         F PSCXL=0:0 S PSCXL=$O(^TMP($J,"PSOLOC",PSCXL)) Q:'PSCXL!($G(PSCLOUT))  D
    126         .I ($Y+7)>IOSL D CLDIR Q:$G(PSCLOUT)
    127         .W !!,"Clinic:   ",$P($G(^SC(+PSCXL,0)),"^")
    128         .W !,"Patients: ",$P($G(^TMP($J,"PSOLOC",PSCXL)),"^"),?16,"Orders: ",$P($G(^TMP($J,"PSOLOC",PSCXL)),"^",2)
    129         .W !,"In Sort Groups:"
    130         .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
    131         ..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
    132         .I '$G(PSCSFLAG) W ?16,"*** NO CLINIC SORT GROUPS ***"
    133         I '$G(PSCLOUT) K DIR S DIR(0)="E",DIR("A")="Press <RET> to continue"  D ^DIR K DIR
    134 SUMMQ   K ^TMP($J,"PSOLOC"),^TMP($J,"PSOLOCP")
    135         Q
    136 CLDIR   K DIR S DIR(0)="E",DIR("A")="Press <RET> to continue, '^' to exit" D ^DIR K DIR I Y'=1 S PSCLOUT=1 Q
    137         W @IOF
    138         Q
    139 RXNCHK  I $G(PSONEW("RX #"))']"" D RXNCHK^PSOORNE5
    140         Q
    141 RDSPL   D RDSPL^PSOORNE5
    142         Q
    143 M3      D M3^PSOOREDX
    144         Q
     1PSOORNE1 ;BIR/SAB - Display new orders from backdoor ;03/06/95
     2 ;;7.0;OUTPATIENT PHARMACY;**11,21,27,32,37,46,71,94,104,117,133,148**;DEC 1997
     3 ;External reference to ^PS(55 is supported by DBIA 2228
     4EN(PSONEW) D DSPL^PSOORNE3,^PSOLMPO2
     5 Q
     6EDT N FLD,LST 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
     7EDTSEL S:'$G(COPY) PSOEDIT=1 S (PSONEW("DFLG"),PSONEW("FIELD"),PSONEW3)=0
     8 I +Y S LST=Y D HLDHDR^PSOLMUTL D  Q:$G(PSORX("DFLG"))!($G(PSORX("QFLG")))  S VALMBCK="R" G DSPL^PSOORNE3
     9 .F FLD=1:1:$L(LST,",") Q:$P(LST,",",FLD)']""  D @(+$P(LST,",",FLD)) Q:$G(PSODIR("DFLG"))!($G(PSODIR("QFLG")))
     10 E  S VALMBCK="" D FULL^VALM1
     11 D RDSPL G DSPL^PSOORNE3
     12 Q
     13ACP K VALMSG,DIR,PSORX("DFLG") D VER I $G(PSONEW2("QFLG"))!($G(PSORX("DFLG"))) S VALMBCK="Q" K PSONEW2 Q
     14 N PSONOBCK S PSONOBCK=$S($G(PSOSIGFL):1,1:0)
     15 D NOOR^PSONEW I $D(DIRUT) S PSONEW("DFLG")=1 K DIR,X,Y,DIRUT,DUOUT,DTOUT Q
     16 D RXNCHK,RDSPL
     17 I $G(PSONEW("QFLG")) S PSONEW("DFLG")=1 K DIR,X,Y,DIRUT,DUOUT,DTOUT Q
     18 D DISPLAY^PSONEW2
     19 D ^PSONEWG I $G(PSOCPZ("DFLG")) S PSONEW("DFLG")=1 K PSOANSQ,DIR,X,Y,DIRUT,DUOUT,DTOUT,PSOCPZ("DFLG"),PSOANSQD Q
     20 K PSOCPZ("DFLG")
     21 K DIR,DIRUT,X,Y S DIR(0)="Y",DIR("B")="YES",DIR("A")="Is this correct" D ^DIR
     22 I $D(DIRUT) S PSONEW("DFLG")=1 K PSOANSQ,PSOANSQD,DIR,X,Y,DIRUT,DUOUT,DTOUT Q
     23 I 'Y S VALMBCK="R" K PSOANSQ,DIR,X,Y,DIRUT,DUOUT,DTOUT D DSPL^PSOORNE3 Q
     24 W "..." K PSOANSQD,DIR,X,Y,DIRUT,DUOUT,DTOUT D DCORD^PSONEW2
     25 I $G(NCPDPFLG) D NCPDP^PSOORED6
     26 K:$G(COPY)!($G(PSOSIGFL)) PRC,PHI
     27 S:'$G(PSOID) PSOID=DT S (PSORX("FN"),PSONEW("POE"))=1 D EN^PSON52(.PSONEW) ; Files entry in File 52
     28 I $G(PSOBEDT) D
     29 .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
     30 .S ^TMP("PSOBEDT",$J,PSODFN,0)=^TMP("PSOBEDT",$J,PSODFN,0)_","_PSORXED("IRXN")
     31 .I $G(PSONEW("MAIL/WINDOW"))["W" S ^TMP("PSOBEDT",$J,PSODFN,1)=1
     32 D NPSOSD^PSOUTIL(.PSONEW) ; Adds newly added rx to PSOSD array
     33 D ^PSOBUILD S VALMBCK="Q"
     34 K PSONEW("# OF REFILLS"),PSONEW("DAYS SUPPLY"),SDA,SEG1,SSN1,STA,Z4,ZDA
     35 Q:$G(COPY)  S PSONEW("DFLG")=0
     36 Q
     37VER I $G(PSOAC),$G(PSODRUG("NAME"))']"" D FULL^VALM1,2^PSOORNW1
     38 I $G(PSODRUG("NAME"))']"" S VALMSG="A Dispense Drug Must be Chosen!" S PSONEW2("QFLG")=1 Q
     39 I '$G(PSONEW("ENT")) W !,"Dosing Instruction Missing!!",! D  I PSONEW("DFLG")=1 S PSONEW2("QFLG")=1 Q
     40 .S PSOORRNW=1
     41 .K VALMSG D FULL^VALM1 W !,"Drug: "_PSODRUG("NAME")
     42 .I $O(SIG(0)) F I=1:1 Q:$G(SIG(I))']""  W !,SIG(I)
     43 .E   I $G(^PSRX(PSONEW("OIRXN"),"SIG"))]"" S X=$P(^PSRX(PSONEW("OIRXN"),"SIG"),"^") D SIGONE^PSOHELP W !,$E($G(INS1),2,250)
     44 .W ! D 5 K PSOORRNW I PSONEW("DFLG")=1 D M3 Q
     45 .D 6 D:PSONEW("DFLG")=1 M3
     46 D:$G(COPY) PROV^PSOUTIL(.PSORENW) I PSONEW("DFLG")=1 S PSONEW2("QFLG")=1 Q
     47 D FULL^VALM1,POST^PSODRG:'$G(PSOSIGFL) K PSONOOR I $G(PSORX("DFLG")) S VALMBCK="Q" Q
     48 I +$G(PSEXDT) D
     49 .D FULL^VALM1 S:$G(PSONEW("MAIL/WINDOW"))["W" BINGCRT="Y",BINGRTE="W"
     50 .D:+$G(PSEXDT)
     51 ..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_"."
     52 .S PSONEW2("QFLG")=1,VALMBCK="R" D PAUSE^VALM1
     53 Q
     541 I $G(PSOSIGFL) S PSOAC=1 D 2^PSOORNW1 K PSOAC D RDSPL G DSPL^PSOORNE3 Q
     55 D 6^PSOBKDED D RDSPL G DSPL^PSOORNE3 Q
     56 ;
     572 D 3^PSOBKDED Q
     58 ;
     593 D 1^PSOBKDED Q
     60 ;
     614 D 2^PSOBKDED Q
     62 ;
     635 I '$G(PSODRUG("IEN")) W !,"DRUG NAME REQUIRED!" D 2^PSOORNW1 I '$G(PSODRUG("IEN")) S VALMSG="No Dispense Drug Selected" Q
     64 W !!,"Drug: "_PSODRUG("NAME") D 10^PSOBKDED Q
     65 ;
     666 D INS^PSOBKDED Q:$G(PSONEW("DFLG"))  I $P($G(^PS(55,PSODFN,"LAN")),"^") D SINS^PSODIR(.PSONEW)
     67 Q
     68 ;
     697 D 8^PSOBKDED Q
     70 ;
     718 D 7^PSOBKDED Q
     72 ;
     739 D 9^PSOBKDED Q
     74 ;
     7510 D 12^PSOBKDED Q
     76 ;
     7711 D 5^PSOBKDED Q
     78 ;
     7912 D 4^PSOBKDED Q
     80 ;
     8113 D 11^PSOBKDED Q
     82 ;
     8314 D 13^PSOBKDED Q
     84 ;
     85SUMM ;print break down of orders to be finished
     86 K ^TMP($J,"PSOCZT"),^TMP($J,"PSODPAT"),PAT,RT,DIR,DUOUT,DIRUT,PSZLQUIT
     87 S DIR("A")="Do you want an Order Summary",DIR(0)="Y",DIR("B")="No"
     88 D ^DIR K DIR I 'Y!($D(DIRUT)) K Y,X,DIRUT Q
     89 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
     90 I $D(^PS(52.41,"ACL")) N PSOCLSUM D SUMMCL I $G(PSOCLSUM) K PSOINPRT Q
     91 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
     92 .I '$D(^TMP($J,"PSOCZT",PSID,"PAT")) F PZA="PAT","WIN","MAIL","CLIN" S ^TMP($J,"PSOCZT",PSID,PZA)=0
     93 .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
     94 .S PZROUT=$P($G(^PS(52.41,PIN,0)),"^",17) I PZROUT'="" S ^TMP($J,"PSOCZT",PSID,$S(PZROUT="C":"CLIN",PZROUT="M":"MAIL",1:"WIN"))=^TMP($J,"PSOCZT",PSID,$S(PZROUT="C":"CLIN",PZROUT="M":"MAIL",1:"WIN"))+1
     95 W @IOF W !?20,"Pending Outpatient Medication Orders",! I $G(PSZCNT)>1 W ?20,"(signed in under "_$G(PSOINPRT)_")",!
     96 F PSOINL=0:0 S PSOINL=$O(^TMP($J,"PSOCZT",PSOINL)) Q:'PSOINL!($G(PSZLQUIT))  D
     97 .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
     98 ..W @IOF W !?20,"Pending Outpatient Medication Orders",! I $G(PSZCNT)>1 W ?20,"(signed in under "_$G(PSOINPRT)_")",!
     99 .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
     100 .W !,"Division: ",$G(PSOINPRX)
     101 .W !,"Patients: "_$G(^TMP($J,"PSOCZT",PSOINL,"PAT"))_"  Window: "_$G(^("WIN"))_"  Mail: "_$G(^("MAIL"))_"  Clinic: "_$G(^("CLIN")),!
     102 K DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIR
     103 K ^TMP($J,"PSOCZT"),^TMP($J,"PSODPAT"),RT,PSOINPRT,PSOINPRX,PSI,PSID,PIN,PZA,PZROUT,PSOINL,PSZLQUIT
     104 Q
     105SUMMCL ;
     106 W ! K DIR S DIR(0)="SMB^D:DIVISION;C:CLINIC",DIR("A")="Do you want the summary by Division or Clinic",DIR("B")="Division",DIR("?")=" "
     107 S DIR("?",1)="Enter 'D' to see the summary by Division, and within Division 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."
     108 D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) S PSOCLSUM=1 Q
     109 Q:$G(Y)="D"
     110 S PSOCLSUM=1
     111 K ^TMP($J,"PSOLOC"),^TMP($J,"PSOLOCP") N PSCX,PSCXL,PSLX,PSCIN,PSCPT,PSCNDE,PSNCL,PSNPAT,PSCLOUT,PSCSFLAG,PCCNT,PSOCAG
     112 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
     113 .S PSCNDE=$G(^PS(52.41,PSCIN,0))
     114 .I $P(PSCNDE,"^",3)'="NW",$P(PSCNDE,"^",3)'="RNW",$P(PSCNDE,"^",3)'="RF" Q
     115 .I $P(PSCNDE,"^",13)="" Q
     116 .S PSNCL=+$P(PSCNDE,"^",13),PSNPAT=+$P(PSCNDE,"^",2)
     117 .I '$D(^TMP($J,"PSOLOC",PSNCL)) S ^TMP($J,"PSOLOC",PSNCL)="1^1",^TMP($J,"PSOLOCP",PSNCL,PSNPAT)="" Q
     118 .S $P(^TMP($J,"PSOLOC",PSNCL),"^",2)=$P(^TMP($J,"PSOLOC",PSNCL),"^",2)+1
     119 .I '$D(^TMP($J,"PSOLOCP",PSNCL,PSNPAT)) S $P(^TMP($J,"PSOLOC",PSNCL),"^")=$P(^TMP($J,"PSOLOC",PSNCL),"^")+1
     120 .S ^TMP($J,"PSOLOCP",PSNCL,PSNPAT)=""
     121 I '$O(^TMP($J,"PSOLOC",0)) G SUMMQ
     122 W @IOF W !?20,"Pending Outpatient Medication Orders" I $G(PSZCNT)>1 W !?20,"(signed in under "_$G(PSOINPRT)_")"
     123 F PSCXL=0:0 S PSCXL=$O(^TMP($J,"PSOLOC",PSCXL)) Q:'PSCXL!($G(PSCLOUT))  D
     124 .I ($Y+7)>IOSL D CLDIR Q:$G(PSCLOUT)
     125 .W !!,"Clinic:   ",$P($G(^SC(+PSCXL,0)),"^")
     126 .W !,"Patients: ",$P($G(^TMP($J,"PSOLOC",PSCXL)),"^"),?16,"Orders: ",$P($G(^TMP($J,"PSOLOC",PSCXL)),"^",2)
     127 .W !,"In Sort Groups:"
     128 .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
     129 ..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
     130 .I '$G(PSCSFLAG) W ?16,"*** NO CLINIC SORT GROUPS ***"
     131 I '$G(PSCLOUT) K DIR S DIR(0)="E",DIR("A")="Press <RET> to continue"  D ^DIR K DIR
     132SUMMQ K ^TMP($J,"PSOLOC"),^TMP($J,"PSOLOCP")
     133 Q
     134CLDIR K DIR S DIR(0)="E",DIR("A")="Press <RET> to continue, '^' to exit" D ^DIR K DIR I Y'=1 S PSCLOUT=1 Q
     135 W @IOF
     136 Q
     137RXNCHK I $G(PSONEW("RX #"))']"" D RXNCHK^PSOORNE5
     138 Q
     139RDSPL D RDSPL^PSOORNE5
     140 Q
     141M3 D M3^PSOOREDX
     142 Q
Note: See TracChangeset for help on using the changeset viewer.