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/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSGOEF.m

    r613 r623  
    1 PSGOEF  ;BIR/CML3-FINISH ORDERS ENTERED THROUGH OE/RR ;14 May 98 / 2:17 PM
    2         ;;5.0; INPATIENT MEDICATIONS ;**7,30,29,35,39,47,50,56,80,116,110,111,133,153,134**;16 DEC 97;Build 124
    3         ;
    4         ; Reference to ^PS(55 is supported by DBIA 2191
    5         ; Reference to ^PSDRUG( is supported by DBIA 2192
    6         ; Reference to DOSE^PSSORPH is supported by DBIA 3234.
    7         ;
    8 START   ;
    9         I '$D(^PS(53.1,+PSGORD)) W $C(7),!?3,"Cannot find this pending order (#",+PSGORD,")." Q
    10         D NOW^%DTC S PSGDT=+$E(%,1,12) K PSGFDX,PSGEFN,PSGOEEF,PSGOES,PSGONF,PSGRDTX S PSGOES=1,(PSGOEF,PSGOEEF)=0,PSGOEEG=3
    11         I $D(PSJTUD) S PSGDO=$P($G(^PS(53.1,+PSGORD,.3)),U),(PSGPDRG,PSGPD)=PSJCOI,(PSGPDRGN,PSGPDN)=$$OINAME^PSJLMUTL(PSGPD)
    12         I $P($G(^PS(53.1,+PSGORD,0)),U,24)'="R" S X=PSGSCH D EN^PSGORS0 D
    13         . S:($D(X)&($P($G(^PS(53.1,+PSGORD,2)),"^",5)="")&($P($G(^PS(53.1,+PSGORD,0)),"^",24)="N")) PSGAT=PSGS0Y
    14         . NEW PSJDOX,PSJDOSE,PSJPIECE,PSJUNIT,PSJX,X
    15         . S X=$G(^PS(53.1,+PSGORD,1,1,0)) Q:'+X
    16         . D DOSE^PSSORPH(.PSJDOX,+X,"U")
    17         . I $S('$D(PSJDOX):1,1:+PSJDOX(1)=-1) Q
    18         . S PSJPIECE=$S($P(PSJDOX(1),U)="":3,1:1)
    19         . S X=^PS(53.1,+PSGORD,.2)
    20         . S:PSJPIECE=3 PSJDOSE=$P(X,U,2)
    21         . S:PSJPIECE=1 PSJDOSE=$P(X,U,5),PSJUNIT=$P(X,U,6)
    22         . F X=0:0 S X=$O(PSJDOX(X)) Q:+$G(PSJX)!'X  D
    23         .. I PSJPIECE=3,($P(PSJDOX(X),U,3)'=PSJDOSE) Q
    24         .. I PSJPIECE=1,($P(PSJDOX(X),U,1)_$P(PSJDOX(X),U,2)'=(PSJDOSE_PSJUNIT)) Q
    25         .. S:+$P(PSJDOX(X),U,12) $P(^PS(53.45,PSJSYSP,2,1,0),U,2)=+$P(PSJDOX(X),U,12),PSJX=1
    26         I PSGEB'=PSGOPR F X=7,11 S Y=$T(@(3_X)),@("PSGEFN("_X_")="_$P(Y,";",7)),PSGOEEF(+$P(Y,";",3))="",PSGOEEF=PSGOEEF+1
    27         D GTST^PSGOE6(+PSGORD)
    28         I $P($G(^PS(53.1,+PSGORD,0)),U,24)'="R" S PSGSD="" D:PSGS0Y]""
    29         .N PSJX S PSJX=$P($G(^PS(53.1,+PSGORD,0)),U,25) I PSJX="" Q
    30         .I PSJX["U" S PSGSD=$P($G(^PS(55,DFN,5,+PSJX,2)),U,2) Q
    31         .I PSJX["V" S PSGSD=$P($G(^PS(55,DFN,"IV",+PSJX,0)),U,2) Q
    32         .I PSJX["P" S PSGSD=$P($G(^PS(53.1,+PSJX,2)),U,2)
    33         S:PSGSD="" PSGSD=PSGLI
    34         S PSGNEDFD=$$GTNEDFD^PSGOE7("U",+PSGPD)
    35         S:$P($G(PSGNEDFD),U,3)="" $P(PSGNEDFD,U,3)=PSGST  ; N PSGOEA S PSGOEA="R"
    36         S (PSGNESD,PSGSD)=$$ENSD^PSGNE3(PSGSCH,PSGS0Y,PSGLI,PSGSD)
    37         ;if this is a renewal order, ignore any 'requested start date' received.  Use the system calculated start date.
    38         I $P($G(^PS(53.1,+PSGORD,0)),U,24)'="R" D
    39         . D REQDT^PSJLIVMD(PSGORD)
    40         E  D
    41         . S X=$$DSTART^PSJDCU(DFN,$P(^PS(53.1,+PSGORD,0),U,25)) I X]"" S (PSGNESD,PSGSD)=X K PSGRSD
    42         D   ; Extend the Default Stop Date if needed for the first renewed order.
    43         .N PSGOEAO,PSGWALLO
    44         .I $P($G(^PS(53.1,+PSGORD,0)),U,24)="R" S PSGOEAO=PSGOEA,PSGOEA="R",PSGWALLO=$P(^PS(55,DFN,5.1),U)
    45         .D ENFD^PSGNE3(PSGLI) S PSGFD=$S($G(PSGRDTX(+PSGORD,"PSGFD")):PSGRDTX(+PSGORD,"PSGFD"),1:PSGNEFD)
    46         .I $P($G(^PS(53.1,+PSGORD,0)),U,24)="R" S PSGOEA=PSGOEAO,$P(^PS(55,DFN,5.1),U)=PSGWALLO
    47         N DUR,PSGRNSD S PSGRNSD=+$$LASTREN^PSJLMPRI(DFN,PSGORD) I PSGRNSD S DUR=$$GETDUR^PSJLIVMD(DFN,PSGORD,"P",1) I DUR]"" D
    48         . N DURMIN S DURMIN=$$DURMIN^PSJLIVMD(DUR) I DURMIN S PSGFD=$$FMADD^XLFDT(PSGRNSD,,,DURMIN)
    49         S PSGOFD="",PSGSDN=$$ENDD^PSGMI(PSGSD)_U_$$ENDTC^PSGMI(PSGSD),PSGFDN=$$ENDD^PSGMI(PSGFD)_U_$$ENDTC^PSGMI(PSGFD)
    50         S PSGLIN=$$ENDD^PSGMI(PSGLI)_U_$$ENDTC^PSGMI(PSGLI)
    51         I '$O(^PS(53.45,PSJSYSP,2,0)) N DRG,DRGCNT S DRGCNT=0 D
    52         .F X=0:0 S X=$O(^PSDRUG("ASP",+PSGPD,X)) Q:'X!(DRGCNT>1)  S:$P($G(^PSDRUG(+X,2)),U,3)["U" DRGCNT=DRGCNT+1,DRG=+X
    53         .I DRGCNT=1 K ^PS(53.45,PSJSYSP,2) S ^PS(53.45,PSJSYSP,2,1,0)=DRG_U_1,^PS(53.45,PSJSYSP,2,0)="^53.4502^1^1",PS(53.45,PSJSYSP,2,"B",+DRG,1)=""
    54         Q
    55 FINISH  ;
    56         ; force display of second screen if CPRS order checks exist
    57         N NSFF,PSGOEF39 S NSFF=1 K PSJNSS
    58         I $G(PSGORD),$D(PSGRDTX(+PSGORD)) D  K PSGRDTX
    59         . S:$G(PSGRDTX(+PSGORD,"PSGRSD")) PSGSD=PSGRDTX(+PSGORD,"PSGRSD")
    60         . S:$G(PSGRDTX(+PSGORD,"PSGRFD")) PSGFD=$S($G(PSGRDTX(+PSGORD,"PSGRFD")):PSGRDTX(+PSGORD,"PSGRFD"),1:$G(PSGNEFD))
    61         N PSJCOM S PSJCOM=+$P($G(^PS(53.1,+PSGORD,.2)),"^",8)
    62         I $O(^PS(53.1,+PSGORD,12,0))!$O(^PS(53.1,+PSGORD,10,0)) D
    63         .Q:$G(PSJLMX)=1  ; there's no second screen to display
    64         .S VALMBG=16 D RE^VALM4,PAUSE^VALM1
    65         D FULL^VALM1
    66         I $G(PSJPROT)=3,'$D(PSJTUD),'$$ENIVUD^PSGOEF1(PSGORD) Q
    67         I $G(PSGOSCH)]"" D  S:$G(PSGS0XT)'="" $P(^PS(53.1,+PSGORD,2),"^",6)=PSGS0XT
    68         .N PSGOES,PSGS0Y,PSGSCH S X=PSGOSCH K:$G(PSJTUD) NSFF D ENOS^PSGS0
    69         .I '($G(PSGORD)["P"&($P($G(^PS(53.1,+PSGORD,0)),"^",24)="R")) I $G(X)]""&$G(PSGS0Y) S:$G(PSGAT)="" PSGAT=PSGS0Y
    70         .I $G(PSJNSS) S PSGOSCH="" K PSJNSS
    71         .I $G(PSGORD)["P",$G(PSGAT),$G(PSGS0Y),($G(PSGOSCH)]"") I PSGAT'=PSGS0Y D
    72         ..S PSGNSTAT=1 W $C(7),!!,"PLEASE NOTE:  This order's admin times (",PSGAT,")"
    73         ..W !?13," do not match the ward times (",PSGS0Y,")"
    74         ..W !?13," for this administration schedule (",PSGOSCH,")",!
    75         ..S DIR(0)="EA",DIR("A")="Press Return to continue..." D ^DIR K DIR  W !
    76         I $G(PSGS0XT)="" S $P(^PS(53.1,+PSGORD,2),"^",6)=$S($P($G(ZZND),"^",3)'="":$P(ZZND,"^",3),1:"")
    77         S CHK=0 S:$P($G(^PS(53.1,+PSGORD,0)),U,24)'="R" PSGSI=$$ENPC^PSJUTL("U",+PSJSYSP,180,PSGSI)
    78         I '$G(PSJTUD),$G(PSJNSS),($G(PSGOSCH)]"") D NSSCONT^PSGS0(PSGOSCH,PSGS0XT) K PSJNSS S PSGOSCH=""
    79         S PSGOEFF=PSGOSCH=""+('$O(^PS(53.45,PSJSYSP,2,0))*10)
    80         I PSGOEFF S X=$S(PSGOEFF#2:" a SCHEDULE",1:"")_$S(PSGOEFF=11:" and",1:"")_$S(PSGOEFF>9:" at least one DISPENSE DRUG",1:"")
    81         I 'PSGOEFF I (($G(PSGS0XT)="D")&($G(PSGAT)="")) S X=" Admin Times",PSGOEFF=1,PSGOEF39=1
    82         I PSGOEFF,X]"" S X=X_" before it can be finished."
    83         I PSGOEFF S CHK=1 W $C(7),!!,"PLEASE NOTE: This order must have" F Q=1:1:$L(X," ") S Y=$P(X," ",Q) W:$L(Y)+$X>78 ! W Y," "
    84         I $G(PSGOEF39) S PSGOEE=0,PSGOEFF=0 D  I 'PSGOEE D REFRESH^VALM G DONE
    85         .S F1=53.1,MSG=0,Y=$T(39),@("PSGFN(39)="_$P(Y,";",7)),PSGOEEF(+$P(Y,";",3))=1,(PSGOEEF,PSGOEE)=1 W ! D @$P($T(39),";",3) S CHK=0
    86         I PSGOEFF=1 S F1=53.1,MSG=0,Y=$T(38),@("PSGFN(38)="_$P(Y,";",7)),PSGOEEF(+$P(Y,";",3))=1,(PSGOEE,PSGOEEF)=1 W ! D @$P($T(38),";",3) S CHK=0 G:'PSGOEE DONE
    87         I PSGOEFF=11 S F1=53.1,MSG=0,Y=$T(32),@("PSGFN(32)="_$P(Y,";",7)),PSGOEEF(+$P(Y,";",3))=1,(PSGOEE,PSGOEEF)=1 W ! D @$P($T(32),";",3) D  G:'PSGOEE DONE
    88         .S F1=53.1,MSG=0,Y=$T(38),@("PSGFN(38)="_$P(Y,";",7)),PSGOEEF(+$P(Y,";",3))=1,(PSGOEE,PSGOEEF)=1 W ! D @$P($T(38),";",3) S CHK=0
    89         I PSGOEFF>9 S CHK=7 D ENDRG^PSGOEF1(+PSGPD,0) I CHK D ABORTACC Q
    90         I 'PSGOEFF D OC531^PSGOESF ; check every dispense drug from CPRS
    91         S VALMBG=1
    92         I 'PSGOEFF&($D(PSGORQF)) D RE^VALM4 Q
    93         I $G(MSG) K DIR S DIR(0)="E" W !! D ^DIR
    94         I PSGOEFF D:PSGST="" GTST^PSGOE6(+PSGORD)
    95         S PSJLMFIN=1
    96         K PSJACEPT I $O(^PS(53.1,+PSGORD,12,0)) S PSJLMP2=1
    97         S PSGOEENO=0,PSGSTAT=$S($P(PSJSYSP0,U,9):"ACTIVE",1:"NON-VERIFIED")
    98         NEW PSJDOSE,PSJDOX,PSJDSFLG
    99         D DOSECHK^PSJDOSE
    100         S:+$G(PSJDSFLG) VALMSG="Dosage Ordered & Dispense Drug are not compatible"
    101         I PSGODO=PSGDO S PSGOEEF(109)=""
    102         I PSGODO'=PSGDO S PSGOEENO=1,VALMSG="This change will cause a new order to be created  "
    103         D EN^VALM("PSJU LM ACCEPT")
    104         I $G(PSJNSS) D  S PSGOEEF(26)="" K PSJACEPT,PSJNSS
    105         .K DIR S DIR(0)="FOA",DIR("A")="Invalid Schedule" D ^DIR K DIR
    106         I $G(PSGS0XT)="D",'$G(PSGS0Y),'$G(PSGAT),((",P,R,")'[(","_$G(PSGST)_",")) D  S PSGOEEF(39)="" K PSJACEPT
    107         .K DIR S DIR(0)="FOA",DIR("A")="   WARNING - Admin times are required for DAY OF WEEK schedules  " D ^DIR K DIR
    108         I '$G(PSJACEPT) D ABORTACC Q
    109         I $G(PSJRNF),$G(^PS(53.1,+PSGORD,4)) D
    110         . W $C(7),!!,"ACCEPTING THIS ORDER WILL CHANGE THE STATUS TO ACTIVE."
    111         . S DIR(0)="Y",DIR("A")="Do you wish to make this order Active",DIR("?",1)="Enter ""N"" if you wish to exit without Activating this order,"
    112         . S DIR("?")="or ""Y"" to continue with the Activation process." D ^DIR S:'Y Y=-1 K DIR
    113         I $G(PSJRNF),$G(Y)=-1 S PSJACEPT=0 D ABORTACC Q
    114         I $G(PSJRNF),$G(Y)=1 S PSGOEAV=1
    115         I PSGOEENO S PSJNOO=$$ENNOO^PSJUTL5("E"),PSJACEPT=$S(PSJNOO<0:0,1:1)
    116 ACCEPT  ;
    117         S VALMBCK=$S($G(PSJACEPT):"Q",1:"R")
    118         I '$G(PSJACEPT) D ABORTACC Q
    119         K PSGOES,PSGRSD,PSGRSDN D:PSGOEENO NEW3^PSGOEE D:'PSGOEENO UPD^PSGOEF1 I $D(PSGOEF)!PSGOEENO S PSGCANFL=-1
    120         D DONE1^PSGOEE
    121         D DONE
    122         Q
    123 BYPASS  ;
    124         S PSGCANFL=1
    125         ;
    126 DONE    ;
    127         K CHK,DA,DIE,DR,DRG,MSG,Q1,Q2,PSGNSTAT ;PSGND,PSGOEE,PSGOEEF,PSGOEEND,PSGOEEG,PSGOEF,PSGOEFF,PSGOES,PSGOPD,PSGOPDN,PSGOPR,PSGOSCH,PSGPDRG,PSGDRGN,PSG0XT,PSGS0Y,OSGSD,Q1,Q2
    128         Q
    129 ABORTACC        ; Abort Accept process.
    130         D ABORT^PSGOEE K PSGOEEF D GETUD^PSJLMGUD(PSGP,PSGORD),^PSGOEF,ENSFE^PSGOEE0(PSGP,PSGORD),INIT^PSJLMUDE(PSGP,PSGORD) S VALMBCK="R",PSGSD=PSGNESD,PSGFD=PSGNEFD Q
    131         ;
    132         ;
    133 31      ;;101^PSGOE8;PSGOPD;PSGPD;101;1
    134 32      ;;109^PSGOE8;PSGODO;PSGDO;109;PSGODO]""
    135 33      ;;10^PSGOE81;PSGOSD;PSGSD;10;0
    136 34      ;;3^PSGOE8;PSGOMR;PSGMR;3;1
    137 35      ;;25^PSGOE81;PSGOFD;PSGFD;25;0
    138 36      ;;7^PSGOE8;PSGOST;PSGST;7;0
    139 37      ;;5^PSGOE82;PSGOSM;PSGSM;5;0
    140 38      ;;26^PSGOE8;PSGOSCH;PSGSCH;26;1     
    141 39      ;;39^PSGOE81;PSGOAT;PSGAT;39;0
    142 310     ;;1^PSGOE82;PSGOPR;PSGPR;1;1
    143 311     ;;8^PSGOE81;PSGOSI;PSGSI;8;0
    144 312     ;;2^PSGOE82;;;2;0
    145 313     ;;40^PSGOE82;;;40;0
    146         ;
    147 AH      ;
    148         W !!?2,"Answer 'YES' to accept this order as a NON-VERIFIED UNIT DOSE order.  Answer",!,"'NO' to edit this order now.  Enter '^' to BYPASS this order, leaving it as",!,"a PENDING INPATIENT order."
    149         Q
     1PSGOEF ;BIR/CML3-FINISH ORDERS ENTERED THROUGH OE/RR ;14 May 98 / 2:17 PM
     2 ;;5.0; INPATIENT MEDICATIONS ;**7,30,29,35,39,47,50,56,80,116,110,111,133,153**;16 DEC 97
     3 ;
     4 ; Reference to ^PS(55 is supported by DBIA 2191
     5 ; Reference to ^PSDRUG( is supported by DBIA 2192
     6 ; Reference to DOSE^PSSORPH is supported by DBIA 3234.
     7 ;
     8START ;
     9 I '$D(^PS(53.1,+PSGORD)) W $C(7),!?3,"Cannot find this pending order (#",+PSGORD,")." Q
     10 D NOW^%DTC S PSGDT=+$E(%,1,12) K PSGFDX,PSGEFN,PSGOEEF,PSGOES,PSGONF,PSGRDTX S PSGOES=1,(PSGOEF,PSGOEEF)=0,PSGOEEG=3
     11 I $D(PSJTUD) S PSGDO=$P($G(^PS(53.1,+PSGORD,.3)),U),(PSGPDRG,PSGPD)=PSJCOI,(PSGPDRGN,PSGPDN)=$$OINAME^PSJLMUTL(PSGPD)
     12 I $P($G(^PS(53.1,+PSGORD,0)),U,24)'="R" S X=PSGSCH D EN^PSGORS0 S:$D(X) PSGAT=PSGS0Y D
     13 . NEW PSJDOX,PSJDOSE,PSJPIECE,PSJUNIT,PSJX,X
     14 . S X=$G(^PS(53.1,+PSGORD,1,1,0)) Q:'+X
     15 . D DOSE^PSSORPH(.PSJDOX,+X,"U")
     16 . I $S('$D(PSJDOX):1,1:+PSJDOX(1)=-1) Q
     17 . S PSJPIECE=$S($P(PSJDOX(1),U)="":3,1:1)
     18 . S X=^PS(53.1,+PSGORD,.2)
     19 . S:PSJPIECE=3 PSJDOSE=$P(X,U,2)
     20 . S:PSJPIECE=1 PSJDOSE=$P(X,U,5),PSJUNIT=$P(X,U,6)
     21 . F X=0:0 S X=$O(PSJDOX(X)) Q:+$G(PSJX)!'X  D
     22 .. I PSJPIECE=3,($P(PSJDOX(X),U,3)'=PSJDOSE) Q
     23 .. I PSJPIECE=1,($P(PSJDOX(X),U,1)_$P(PSJDOX(X),U,2)'=(PSJDOSE_PSJUNIT)) Q
     24 .. S:+$P(PSJDOX(X),U,12) $P(^PS(53.45,PSJSYSP,2,1,0),U,2)=+$P(PSJDOX(X),U,12),PSJX=1
     25 I PSGEB'=PSGOPR F X=7,11 S Y=$T(@(3_X)),@("PSGEFN("_X_")="_$P(Y,";",7)),PSGOEEF(+$P(Y,";",3))="",PSGOEEF=PSGOEEF+1
     26 D GTST^PSGOE6(+PSGORD)
     27 I $P($G(^PS(53.1,+PSGORD,0)),U,24)'="R" S PSGSD="" D:PSGS0Y]""
     28 .N PSJX S PSJX=$P($G(^PS(53.1,+PSGORD,0)),U,25) I PSJX="" Q
     29 .I PSJX["U" S PSGSD=$P($G(^PS(55,DFN,5,+PSJX,2)),U,2) Q
     30 .I PSJX["V" S PSGSD=$P($G(^PS(55,DFN,"IV",+PSJX,0)),U,2) Q
     31 .I PSJX["P" S PSGSD=$P($G(^PS(53.1,+PSJX,2)),U,2)
     32 S:PSGSD="" PSGSD=PSGLI
     33 S PSGNEDFD=$$GTNEDFD^PSGOE7("U",+PSGPD)
     34 S:$P($G(PSGNEDFD),U,3)="" $P(PSGNEDFD,U,3)=PSGST  ; N PSGOEA S PSGOEA="R"
     35 S (PSGNESD,PSGSD)=$$ENSD^PSGNE3(PSGSCH,PSGS0Y,PSGLI,PSGSD)
     36 ;if this is a renewal order, ignore any 'requested start date' received.  Use the system calculated start date.
     37 I $P($G(^PS(53.1,+PSGORD,0)),U,24)'="R" D
     38 . D REQDT^PSJLIVMD(PSGORD)
     39 E  D
     40 . S X=$$DSTART^PSJDCU(DFN,$P(^PS(53.1,+PSGORD,0),U,25)) I X]"" S (PSGNESD,PSGSD)=X K PSGRSD
     41 D   ; Extend the Default Stop Date if needed for the first renewed order.
     42 .N PSGOEAO,PSGWALLO
     43 .I $P($G(^PS(53.1,+PSGORD,0)),U,24)="R" S PSGOEAO=PSGOEA,PSGOEA="R",PSGWALLO=$P(^PS(55,DFN,5.1),U)
     44 .D ENFD^PSGNE3(PSGLI) S PSGFD=$S($G(PSGRDTX(+PSGORD,"PSGFD")):PSGRDTX(+PSGORD,"PSGFD"),1:PSGNEFD)
     45 .I $P($G(^PS(53.1,+PSGORD,0)),U,24)="R" S PSGOEA=PSGOEAO,$P(^PS(55,DFN,5.1),U)=PSGWALLO
     46 N DUR,PSGRNSD S PSGRNSD=+$$LASTREN^PSJLMPRI(DFN,PSGORD) I PSGRNSD S DUR=$$GETDUR^PSJLIVMD(DFN,PSGORD,"P",1) I DUR]"" D
     47 . N DURMIN S DURMIN=$$DURMIN^PSJLIVMD(DUR) I DURMIN S PSGFD=$$FMADD^XLFDT(PSGRNSD,,,DURMIN)
     48 S PSGOFD="",PSGSDN=$$ENDD^PSGMI(PSGSD)_U_$$ENDTC^PSGMI(PSGSD),PSGFDN=$$ENDD^PSGMI(PSGFD)_U_$$ENDTC^PSGMI(PSGFD)
     49 S PSGLIN=$$ENDD^PSGMI(PSGLI)_U_$$ENDTC^PSGMI(PSGLI)
     50 I '$O(^PS(53.45,PSJSYSP,2,0)) N DRG,DRGCNT S DRGCNT=0 D
     51 .F X=0:0 S X=$O(^PSDRUG("ASP",+PSGPD,X)) Q:'X!(DRGCNT>1)  S:$P($G(^PSDRUG(+X,2)),U,3)["U" DRGCNT=DRGCNT+1,DRG=+X
     52 .I DRGCNT=1 K ^PS(53.45,PSJSYSP,2) S ^PS(53.45,PSJSYSP,2,1,0)=DRG_U_1,^PS(53.45,PSJSYSP,2,0)="^53.4502^1^1",PS(53.45,PSJSYSP,2,"B",+DRG,1)=""
     53 Q
     54FINISH ;
     55 ; force display of second screen if CPRS order checks exist
     56 N NSFF,PSGOEF39 S NSFF=1 K PSJNSS
     57 I $G(PSGORD),$D(PSGRDTX(+PSGORD)) D  K PSGRDTX
     58 . S:$G(PSGRDTX(+PSGORD,"PSGRSD")) PSGSD=PSGRDTX(+PSGORD,"PSGRSD")
     59 . S:$G(PSGRDTX(+PSGORD,"PSGRFD")) PSGFD=$S($G(PSGRDTX(+PSGORD,"PSGRFD")):PSGRDTX(+PSGORD,"PSGRFD"),1:$G(PSGNEFD))
     60 N PSJCOM S PSJCOM=+$P($G(^PS(53.1,+PSGORD,.2)),"^",8)
     61 I $O(^PS(53.1,+PSGORD,12,0))!$O(^PS(53.1,+PSGORD,10,0)) D
     62 .Q:$G(PSJLMX)=1  ; there's no second screen to display
     63 .S VALMBG=16 D RE^VALM4,PAUSE^VALM1
     64 D FULL^VALM1
     65 I $G(PSJPROT)=3,'$D(PSJTUD),'$$ENIVUD^PSGOEF1(PSGORD) Q
     66 S CHK=0 S:$P($G(^PS(53.1,+PSGORD,0)),U,24)'="R" PSGSI=$$ENPC^PSJUTL("U",+PSJSYSP,180,PSGSI)
     67 I $G(PSGOSCH)]"" D  S:$G(PSGS0XT)'<0 $P(^PS(53.1,+PSGORD,2),"^",6)=PSGS0XT
     68 .N PSGOES,PSGS0Y,PSGSCH S X=PSGOSCH K:$G(PSJTUD) NSFF D ENOS^PSGS0 I '($G(PSGORD)["P"&($P($G(^PS(53.1,+PSGORD,0)),"^",24)="R")) I $G(X)]""&$G(PSGS0Y) S PSGAT=PSGS0Y
     69 .I $G(PSJNSS) S PSGOSCH="" K PSJNSS
     70 I '$G(PSJTUD),$G(PSJNSS),($G(PSGOSCH)]"") D NSSCONT^PSGS0(PSGOSCH,PSGS0XT) K PSJNSS S PSGOSCH=""
     71 S PSGOEFF=PSGOSCH=""+('$O(^PS(53.45,PSJSYSP,2,0))*10)
     72 I PSGOEFF S X=$S(PSGOEFF#2:" a SCHEDULE",1:"")_$S(PSGOEFF=11:" and",1:"")_$S(PSGOEFF>9:" at least one DISPENSE DRUG",1:"")
     73 I 'PSGOEFF I (($G(PSGS0XT)="D")&($G(PSGAT)="")) S X=" Admin Times",PSGOEFF=1,PSGOEF39=1
     74 I PSGOEFF,X]"" S X=X_" before it can be finished."
     75 I PSGOEFF S CHK=1 W $C(7),!!,"PLEASE NOTE: This order must have" F Q=1:1:$L(X," ") S Y=$P(X," ",Q) W:$L(Y)+$X>78 ! W Y," "
     76 I $G(PSGOEF39) S PSGOEE=0,PSGOEFF=0 D  I 'PSGOEE D REFRESH^VALM G DONE
     77 .S F1=53.1,MSG=0,Y=$T(39),@("PSGFN(39)="_$P(Y,";",7)),PSGOEEF(+$P(Y,";",3))=1,(PSGOEEF,PSGOEE)=1 W ! D @$P($T(39),";",3) S CHK=0
     78 I PSGOEFF=1 S F1=53.1,MSG=0,Y=$T(38),@("PSGFN(38)="_$P(Y,";",7)),PSGOEEF(+$P(Y,";",3))=1,(PSGOEE,PSGOEEF)=1 W ! D @$P($T(38),";",3) S CHK=0 G:'PSGOEE DONE
     79 I PSGOEFF=11 S F1=53.1,MSG=0,Y=$T(32),@("PSGFN(32)="_$P(Y,";",7)),PSGOEEF(+$P(Y,";",3))=1,(PSGOEE,PSGOEEF)=1 W ! D @$P($T(32),";",3) D  G:'PSGOEE DONE
     80 .S F1=53.1,MSG=0,Y=$T(38),@("PSGFN(38)="_$P(Y,";",7)),PSGOEEF(+$P(Y,";",3))=1,(PSGOEE,PSGOEEF)=1 W ! D @$P($T(38),";",3) S CHK=0
     81 I PSGOEFF>9 S CHK=7 D ENDRG^PSGOEF1(+PSGPD,0) I CHK D ABORTACC Q
     82 I 'PSGOEFF D OC531^PSGOESF ; check every dispense drug from CPRS
     83 S VALMBG=1
     84 I 'PSGOEFF&($D(PSGORQF)) D RE^VALM4 Q
     85 I $G(MSG) K DIR S DIR(0)="E" W !! D ^DIR
     86 I PSGOEFF D:PSGST="" GTST^PSGOE6(+PSGORD)
     87 S PSJLMFIN=1
     88 K PSJACEPT I $O(^PS(53.1,+PSGORD,12,0)) S PSJLMP2=1
     89 S PSGOEENO=0,PSGSTAT=$S($P(PSJSYSP0,U,9):"ACTIVE",1:"NON-VERIFIED")
     90 NEW PSJDOSE,PSJDOX,PSJDSFLG
     91 D DOSECHK^PSJDOSE
     92 S:+$G(PSJDSFLG) VALMSG="Dosage Ordered & Dispense Drug are not compatible"
     93 I PSGODO=PSGDO S PSGOEEF(109)=""
     94 I PSGODO'=PSGDO S PSGOEENO=1,VALMSG="This change will cause a new order to be created  "
     95 D EN^VALM("PSJU LM ACCEPT")
     96 I $G(PSJNSS) D  S PSGOEEF(26)="" K PSJACEPT,PSJNSS
     97 .K DIR S DIR(0)="FOA",DIR("A")="Invalid Schedule" D ^DIR K DIR
     98 I $G(PSGS0XT)="D",'$G(PSGS0Y),'$G(PSGAT),((",P,R,")'[(","_$G(PSGST)_",")) D  S PSGOEEF(39)="" K PSJACEPT
     99 .K DIR S DIR(0)="FOA",DIR("A")="   WARNING - Admin times are required for DAY OF WEEK schedules  " D ^DIR K DIR
     100 I '$G(PSJACEPT) D ABORTACC Q
     101 I $G(PSJRNF),$G(^PS(53.1,+PSGORD,4)) D
     102 . W $C(7),!!,"ACCEPTING THIS ORDER WILL CHANGE THE STATUS TO ACTIVE."
     103 . S DIR(0)="Y",DIR("A")="Do you wish to make this order Active",DIR("?",1)="Enter ""N"" if you wish to exit without Activating this order,"
     104 . S DIR("?")="or ""Y"" to continue with the Activation process." D ^DIR S:'Y Y=-1 K DIR
     105 I $G(PSJRNF),$G(Y)=-1 S PSJACEPT=0 D ABORTACC Q
     106 I $G(PSJRNF),$G(Y)=1 S PSGOEAV=1
     107 I PSGOEENO S PSJNOO=$$ENNOO^PSJUTL5("E"),PSJACEPT=$S(PSJNOO<0:0,1:1)
     108ACCEPT ;
     109 S VALMBCK=$S($G(PSJACEPT):"Q",1:"R")
     110 I '$G(PSJACEPT) D ABORTACC Q
     111 K PSGOES,PSGRSD,PSGRSDN D:PSGOEENO NEW3^PSGOEE D:'PSGOEENO UPD^PSGOEF1 I $D(PSGOEF)!PSGOEENO S PSGCANFL=-1
     112 D DONE1^PSGOEE
     113 D DONE
     114 Q
     115BYPASS ;
     116 S PSGCANFL=1
     117 ;
     118DONE ;
     119 K CHK,DA,DIE,DR,DRG,MSG,Q1,Q2 ;PSGND,PSGOEE,PSGOEEF,PSGOEEND,PSGOEEG,PSGOEF,PSGOEFF,PSGOES,PSGOPD,PSGOPDN,PSGOPR,PSGOSCH,PSGPDRG,PSGDRGN,PSG0XT,PSGS0Y,OSGSD,Q1,Q2
     120 Q
     121ABORTACC ; Abort Accept process.
     122 D ABORT^PSGOEE K PSGOEEF D GETUD^PSJLMGUD(PSGP,PSGORD),^PSGOEF,ENSFE^PSGOEE0(PSGP,PSGORD),INIT^PSJLMUDE(PSGP,PSGORD) S VALMBCK="R",PSGSD=PSGNESD,PSGFD=PSGNEFD Q
     123 ;
     124 ;
     12531 ;;101^PSGOE8;PSGOPD;PSGPD;101;1
     12632 ;;109^PSGOE8;PSGODO;PSGDO;109;PSGODO]""
     12733 ;;10^PSGOE81;PSGOSD;PSGSD;10;0
     12834 ;;3^PSGOE8;PSGOMR;PSGMR;3;1
     12935 ;;25^PSGOE81;PSGOFD;PSGFD;25;0
     13036 ;;7^PSGOE8;PSGOST;PSGST;7;0
     13137 ;;5^PSGOE82;PSGOSM;PSGSM;5;0
     13238 ;;26^PSGOE8;PSGOSCH;PSGSCH;26;1     
     13339 ;;39^PSGOE81;PSGOAT;PSGAT;39;0
     134310 ;;1^PSGOE82;PSGOPR;PSGPR;1;1
     135311 ;;8^PSGOE81;PSGOSI;PSGSI;8;0
     136312 ;;2^PSGOE82;;;2;0
     137313 ;;40^PSGOE82;;;40;0
     138 ;
     139AH ;
     140 W !!?2,"Answer 'YES' to accept this order as a NON-VERIFIED UNIT DOSE order.  Answer",!,"'NO' to edit this order now.  Enter '^' to BYPASS this order, leaving it as",!,"a PENDING INPATIENT order."
     141 Q
Note: See TracChangeset for help on using the changeset viewer.