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/PSGOECS.m

    r613 r623  
    1 PSGOECS ;BIR/CML3-CANCEL SELECTED ORDERS ;02 Mar 99 / 9:29 AM
    2         ;;5.0; INPATIENT MEDICATIONS ;**23,29,44,58,81,110,134**;16 DEC 97;Build 124
    3         ;
    4         ; Reference to FULL^VALM1 is supported by DBIA# 10116.
    5         ; Reference to ^PS(55 is supported by DBIA# 2191.
    6         ; Reference to ^PSSLOCK is supported by DBIA #2789.
    7         ;
    8 AM      ;
    9         W !,"...marking ",$P(X,U),"..." S $P(^PS(55,PSGP,5,DA,4),"^",11,14)="^1^"_DUZ_"^"_PSGDT,PSGAL("C")=13040 W "." D ^PSGAL5 W "."
    10         I $D(PSJSYSO) S PSGORD=+PSGORD_"A",PSGPOSA="C",PSGPOSD=PSGDT D ENPOS^PSGVDS
    11         Q
    12         ;
    13 NM      ;
    14         W !,"...marking ",$P(X,U),"..." S $P(^PS(53.1,DA,4),"^",11,14)="^1^"_DUZ_"^"_PSGDT W "."
    15         I $D(PSJSYSO) S PSGORD=+PSGORD_"N",PSGPOSD=PSGDT,PSGPOSA="C" D ENPOS^PSGVDS
    16         Q
    17         ;
    18 AC      ; discontinue active order
    19         K DA S DA(1)=PSGP,DA=+PSGORD
    20         S X=$G(^PS(55,PSGP,5,DA,.2))
    21         I $P(X,U,4)="D" W !,$P($$DRUGNAME^PSJLMUTL(DFN,PSGORD),U,1),!,"NO ACTION WAS TAKEN ON DONE ORDER",!,$C(7) HANG 1 Q
    22         NEW XX S XX=$P(^PS(55,PSGP,5,DA,0),U,9)
    23         I $S(XX="E":1,XX="D":1,XX="DE":1,1:0) W !,$P($$DRUGNAME^PSJLMUTL(DFN,PSGORD),U,1),!,"NO ACTION WAS TAKEN ON "_$$CODES^PSIVUTL(XX,55.06,28)_" ORDER",!,$C(7) HANG 1 Q
    24         S X=$$DRUGNAME^PSJLMUTL(PSGP,PSGORD)
    25         I '$P(PSJSYSP0,"^",5) D AM Q
    26         W !,"...discontinuing ",$P(X,U),"...",! S PSGAL("C")=PSJSYSU*10+4000 D ^PSGAL5
    27         S PSGALR=20,DIE="^PS(55,"_PSGP_",5,",DR="28////D;Q;34////"_PSGDT_$S(PSJSYSU:"",1:";49////1"),DP=55.06,$P(^(2),"^",3)=$P(^PS(55,PSGP,5,DA,2),"^",4) D ^DIE S ^PS(55,"AUE",PSGP,DA)=""
    28         D EN1^PSJHL2(PSGP,"OD",PSGORD) S DA(1)=PSGP,DA=+PSGORD
    29         I PSJSYSL S $P(^PS(55,PSGP,5,DA,7),"^",1,2)=PSGDT_"^D",PSGTOL=2,PSGUOW=DUZ,PSGTOO=1 D ENL^PSGVDS
    30         Q
    31         ;
    32 NC      ; discontinue non-verifed order
    33         I $P($G(^PS(53.1,+PSGORD,0)),U,24)="R" S PSJDCTYP=$$PNDRNA^PSGOEC(PSGORD) I $G(PSJDCTYP)'=1 D PNDRN($G(PSJDCTYP)) Q
    34 NC2     ; Called from PNDRN to discontinue both pending renewal and original order
    35         K DA S DA=+PSGORD,X=$G(^PS(53.1,DA,.2)),X=$$DRUGNAME^PSJLMUTL(PSGP,PSGORD)
    36         I $S($P(PSJSYSP0,"^",5):0,'$D(^PS(53.1,DA,4)):1,1:$P(^(4),"^",7)'=DUZ) D NM Q
    37         W !,"...discontinuing ",$P(X,U),"...",! S DIE="^PS(53.1,",DR="28////D"_$S(PSJSYSU:"",1:";42////1") D ^DIE
    38         D EN1^PSJHL2(PSGP,"OC",PSGORD)
    39         S DA=+PSGORD I PSJSYSL,PSJSYSL<3 S $P(^PS(53.1,DA,7),"^",1,2)=PSGDT_"^D",PSGTOO=2,PSGUOW=DUZ,PSGTOL=2 D ENL^PSGVDS
    40         I $G(PSJDCTYP) D UNL^PSSLOCK(DFN,PSGORD)
    41         Q
    42         ;
    43 EN      ; enter here
    44         I $G(PSJIVPRF) D ^PSIVSPDC Q  ;Use for Speed DC in IV Order Profile
    45         D FULL^VALM1
    46 EN1     ;
    47         S (PSGONC,PSGLMT)=PSJOCNT,PSGONW="C" D ENWO^PSGON I "^"[X K X G RESET
    48         D NOW^%DTC S PSGDT=+$E(%,1,12)
    49         W ! F PSGOECS=1:1:PSGODDD F PSGOECS1=1:1 S PSGOECS2=$P(PSGODDD(PSGOECS),",",PSGOECS1) Q:'PSGOECS2  D
    50         .S PSGORD=^TMP("PSJON",$J,PSGOECS2) ; I $P($G(@($S((PSGORD["A")!(PSGORD["U"):"^PS(55,"_PSGP_",5,",(PSGORD["V"):"^PS(55,"_PSGP_",""IV"",",1:"^PS(53.1,")_(+PSGORD)_",0)")),"^",21) Q
    51         S PSJNOO=$$ENNOO^PSJUTL5("D") G:PSJNOO<0 EN1
    52         ;Prompt for requesting provider
    53         W ! I '$$REQPROV^PSGOEC G EN1
    54         W !
    55         ;
    56         ;Replaced above line with block structure below.
    57         N COMFLG,PSJCOM S (EXITLOOP,PSJCOM)=0
    58         F PSGOECS=1:1:PSGODDD D
    59         .F PSGOECS1=1:1 D  Q:EXITLOOP=1
    60         ..S PSGOECS2=$P(PSGODDD(PSGOECS),",",PSGOECS1)
    61         ..I 'PSGOECS2 S EXITLOOP=1 Q
    62         ..S (ON,PSGORD)=^TMP("PSJON",$J,PSGOECS2)
    63         ..I PSGORD=+PSGORD D DCCOM Q
    64         ..I '$$LS^PSSLOCK(DFN,PSGORD) D  Q
    65         ... W:PSGORD'["V" !,$P($$DRUGNAME^PSJLMUTL(DFN,PSGORD),"^",1),!,"NO ACTION WAS TAKEN",!,$C(7) HANG 1 Q
    66         ... W ! I PSGORD["V" N PSJLINE S PSJLINE=1 D DSPLORDV^PSJLMUT1(PSGP,PSGORD) D  W !,"NO ACTION WAS TAKEN",!,$C(7) HANG 1
    67         ....F X=0:0 S X=$O(PSJOC(ON,X)) Q:'X  D
    68         .....W !,$G(PSJOC(ON,X))
    69         ..D CHKCOM I COMFLG  D
    70         ... I PSGORD'["V" W !,$P($$DRUGNAME^PSJLMUTL(DFN,PSGORD),"^",1),!,"NO ACTION WAS TAKEN",!,$C(7) HANG 1 Q
    71         ... W ! I PSGORD["V" N PSJLINE S PSJLINE=1 D DSPLORDV^PSJLMUT1(PSGP,PSGORD) D  W !,"NO ACTION WAS TAKEN",!,$C(7) HANG 1
    72         ....F X=0:0 S X=$O(PSJOC(ON,X)) Q:'X  D
    73         .....W !,$G(PSJOC(ON,X))
    74         ..Q:PSJCOM
    75         ..D:(PSGORD["U") AC
    76         ..D:(PSGORD["P") NC
    77         ..D:(PSGORD["V") SPDCIV^PSIVSPDC
    78         ..; Call the unlock procedure
    79         ..D UNL^PSSLOCK(DFN,PSGORD)
    80         S X=""
    81 RESET   ;
    82         I $G(PSGORD)["V" D INIT^PSJLMHED(3) S VALMBK="R" G DONE
    83         D INIT^PSJLMHED(1) S VALMBCK="R"
    84         ;
    85 DONE    ;
    86         K DA,DIE,DP,DR,PSGAL,PSGALR,PSGLMT,PSGODDD,PSGOECS,PSGOECS1,PSGOECS2,PSGONW,PSGORD,PSGPOSA,PSGPOSD,PSGTOL,PSGTOO,PSGUOW,ORIFN,ORETURN,ORNATR
    87         Q
    88         ;
    89 DCOR    ; Create DC order/update stop date in OE/RR.
    90         S PSOC=$S(PSGORD["P":"OC",PSGORD["N":"OC",1:"OD")
    91         D EN1^PSJHL2(PSGP,PSOC,PSGORD)
    92         Q
    93         ;
    94 ENOR    ;
    95         K DA S PSGEDIT=$S($D(PSGEDIT):PSGEDIT,1:"D"),CF=1,PSGALR=20,DA=+PSGORD,T="" I PSGORD'["U",(PSGORD'["O") D:CF NSET^PSGOEC D NC^PSGOEC D ENOR2 G DONE^PSGOEC
    96         S DA(1)=PSGP D:CF ASET^PSGOEC D AC^PSGOEC
    97         G DONE^PSGOEC
    98         ;
    99 ENOR2   ;Check to see if order being DC'd is a Pending Renewal and is being DC'd due to edit.
    100         I PSGEDIT="DE",$P(^PS(53.1,+PSGORD,0),U,25),$P(^PS(53.1,+PSGORD,0),U,24)="R",PSGSD<$P($G(^PS(55,PSGP,5,+$P(^PS(53.1,+PSGORD,0),U,25),2)),U,4) D
    101         .K DA,DR S DA(1)=PSGP,DA=+$P(^PS(53.1,+PSGORD,0),U,25),DIE="^PS(55,"_PSGP_",5,",DR="34////"_PSGSD_";25////"_$P($G(^PS(55,PSGP,5,+$P(^PS(53.1,+PSGORD,0),U,25),2)),U,4)
    102         .D ^DIE,EN1^PSJHL2(PSGP,"XX",$P(^PS(53.1,+PSGORD,0),U,25))
    103         Q
    104         ;
    105 CHKCOM  ;Check to see if order is part of complex order series.
    106         S PSJCOM=$S(PSGORD["V":$P($G(^PS(55,PSGP,"IV",+PSGORD,.2)),U,8),PSGORD["U":$P($G(^PS(55,PSGP,5,+PSGORD,.2)),U,8),1:$P($G(^PS(53.1,+PSGORD,.2)),U,8)),COMFLG=0
    107         N PSJSTAT S PSJSTAT=$S(PSGORD["V":$P($G(^PS(55,PSGP,"IV",+PSGORD,0)),"^",17),PSGORD["U":$P($G(^PS(55,PSGP,5,+PSGORD,0)),"^",9),1:$P($G(^PS(53.1,+PSGORD,0)),"^",9))
    108         Q:'PSJCOM  I "DE"[PSJSTAT Q
    109         W ! I PSGORD["V" N PSJLINE S PSJLINE=1 D DSPLORDV^PSJLMUT1(PSGP,PSGORD) D
    110         .F X=0:0 S X=$O(PSJOC(ON,X)) Q:'X  D
    111         ..W !,$G(PSJOC(ON,X))
    112         I PSGORD["U" W !,$P($$DRUGNAME^PSJLMUTL(PSGP,PSGORD),"^",1) D
    113         .W !!,"is part of a complex order. If you discontinue this order the following orders",!,"will be discontinued too (unless the stop date has already been reached)." D CMPLX^PSJCOM1(PSGP,PSJCOM,PSGORD)
    114         F  W !!,"Do you want to discontinue this series of complex orders" S %=1 D YN^DICN Q:%
    115         I %'=1 S COMFLG=1 Q
    116         N O,OO S O=0,OO="" F  S O=$O(^PS(55,"ACX",PSJCOM,O)) Q:'O  F  S OO=$O(^PS(55,"ACX",PSJCOM,O,OO)) Q:OO=""  D  Q:COMFLG
    117         .Q:OO=PSGORD  I '$$LS^PSSLOCK(DFN,OO) S COMFLG=1 Q
    118         Q:COMFLG
    119         N O,OO S O=0,OO="" F  S O=$O(^PS(55,"ACX",PSJCOM,O)) Q:'O  F  S OO=$O(^PS(55,"ACX",PSJCOM,O,OO)) Q:OO=""  D
    120         .I (OO["U") N PSGORD S PSGORD=OO D AC
    121         .I (OO["V") N PSGORD S (ON,PSGORD)=OO D SPDCIV^PSIVSPDC
    122         .D UNL^PSSLOCK(DFN,PSGORD)
    123         Q
    124         ;
    125 DCCOM   ;DC pending/non-verified complex order
    126         I '$$LOCK^PSJOEA(DFN,PSGORD) W !,"Order # ",PSGOECS2," could not be discontinued.",!,$C(7) HANG 1 Q
    127         N PSGORD1 S PSGORD1=PSGORD
    128         N PSJO S PSJO=0 F  S PSJO=$O(^PS(53.1,"ACX",PSGORD1,PSJO)) Q:'PSJO  S PSGORD=PSJO_"P" D NC
    129         Q
    130 PNDRN(PSJDCTYP) ; Discontinue both pending renewal and original order
    131         N TMPORD S TMPORD=$G(PSGORD)
    132         I PSJDCTYP=2 S PSJDCTYP=1 D NC2 Q:'$G(PSJDCTYP)  D
    133         .I ($G(PSJNOO)<0) Q
    134         .N ND5310 S ND5310=$G(^PS(53.1,+PSGORD,0))
    135         .N PSGORD S PSGORD=$P(ND5310,"^",25) I PSGORD S PSJDCTYP=2 D
    136         ..I '$$LS^PSSLOCK(DFN,PSGORD) K PSJDCTYP Q
    137         ..D @$S(PSGORD["U":"AC",PSGORD["V":"SPDCIV^PSIVSPDC",1:"")
    138         S PSGORD=TMPORD
    139         Q
     1PSGOECS ;BIR/CML3-CANCEL SELECTED ORDERS ;02 Mar 99 / 9:29 AM
     2 ;;5.0; INPATIENT MEDICATIONS ;**23,29,44,58,81,110**;16 DEC 97
     3 ;
     4 ; Reference to FULL^VALM1 is supported by DBIA# 10116.
     5 ; Reference to ^PS(55 is supported by DBIA# 2191.
     6 ; Reference to ^PSSLOCK is supported by DBIA #2789.
     7 ;
     8AM ;
     9 W !,"...marking ",$P(X,U),"..." S $P(^PS(55,PSGP,5,DA,4),"^",11,14)="^1^"_DUZ_"^"_PSGDT,PSGAL("C")=13040 W "." D ^PSGAL5 W "."
     10 I $D(PSJSYSO) S PSGORD=+PSGORD_"A",PSGPOSA="C",PSGPOSD=PSGDT D ENPOS^PSGVDS
     11 Q
     12 ;
     13NM ;
     14 W !,"...marking ",$P(X,U),"..." S $P(^PS(53.1,DA,4),"^",11,14)="^1^"_DUZ_"^"_PSGDT W "."
     15 I $D(PSJSYSO) S PSGORD=+PSGORD_"N",PSGPOSD=PSGDT,PSGPOSA="C" D ENPOS^PSGVDS
     16 Q
     17 ;
     18AC ; discontinue active order
     19 K DA S DA(1)=PSGP,DA=+PSGORD
     20 S X=$G(^PS(55,PSGP,5,DA,.2))
     21 I $P(X,U,4)="D" W !,$P($$DRUGNAME^PSJLMUTL(DFN,PSGORD),U,1),!,"NO ACTION WAS TAKEN ON DONE ORDER",!,$C(7) HANG 1 Q
     22 NEW XX S XX=$P(^PS(55,PSGP,5,DA,0),U,9)
     23 I $S(XX="E":1,XX="D":1,XX="DE":1,1:0) W !,$P($$DRUGNAME^PSJLMUTL(DFN,PSGORD),U,1),!,"NO ACTION WAS TAKEN ON "_$$CODES^PSIVUTL(XX,55.06,28)_" ORDER",!,$C(7) HANG 1 Q
     24 S X=$$DRUGNAME^PSJLMUTL(PSGP,PSGORD)
     25 I '$P(PSJSYSP0,"^",5) D AM Q
     26 W !,"...discontinuing ",$P(X,U),"...",! S PSGAL("C")=PSJSYSU*10+4000 D ^PSGAL5
     27 S PSGALR=20,DIE="^PS(55,"_PSGP_",5,",DR="28////D;Q;34////"_PSGDT_$S(PSJSYSU:"",1:";49////1"),DP=55.06,$P(^(2),"^",3)=$P(^PS(55,PSGP,5,DA,2),"^",4) D ^DIE S ^PS(55,"AUE",PSGP,DA)=""
     28 D EN1^PSJHL2(PSGP,"OD",PSGORD) S DA(1)=PSGP,DA=+PSGORD
     29 I PSJSYSL S $P(^PS(55,PSGP,5,DA,7),"^",1,2)=PSGDT_"^D",PSGTOL=2,PSGUOW=DUZ,PSGTOO=1 D ENL^PSGVDS
     30 Q
     31 ;
     32NC ; discontinue non-verifed order
     33 K DA S DA=+PSGORD,X=$G(^PS(53.1,DA,.2)),X=$$DRUGNAME^PSJLMUTL(PSGP,PSGORD)
     34 I $S($P(PSJSYSP0,"^",5):0,'$D(^PS(53.1,DA,4)):1,1:$P(^(4),"^",7)'=DUZ) D NM Q
     35 W !,"...discontinuing ",$P(X,U),"...",! S DIE="^PS(53.1,",DR="28////D"_$S(PSJSYSU:"",1:";42////1") D ^DIE
     36 D EN1^PSJHL2(PSGP,"OC",PSGORD)
     37 S DA=+PSGORD I PSJSYSL,PSJSYSL<3 S $P(^PS(53.1,DA,7),"^",1,2)=PSGDT_"^D",PSGTOO=2,PSGUOW=DUZ,PSGTOL=2 D ENL^PSGVDS
     38 Q
     39 ;
     40EN ; enter here
     41 I $G(PSJIVPRF) D ^PSIVSPDC Q  ;Use for Speed DC in IV Order Profile
     42 D FULL^VALM1
     43EN1 ;
     44 S (PSGONC,PSGLMT)=PSJOCNT,PSGONW="C" D ENWO^PSGON I "^"[X K X G RESET
     45 D NOW^%DTC S PSGDT=+$E(%,1,12)
     46 W ! F PSGOECS=1:1:PSGODDD F PSGOECS1=1:1 S PSGOECS2=$P(PSGODDD(PSGOECS),",",PSGOECS1) Q:'PSGOECS2  D
     47 .S PSGORD=^TMP("PSJON",$J,PSGOECS2) ; I $P($G(@($S((PSGORD["A")!(PSGORD["U"):"^PS(55,"_PSGP_",5,",(PSGORD["V"):"^PS(55,"_PSGP_",""IV"",",1:"^PS(53.1,")_(+PSGORD)_",0)")),"^",21) Q
     48 S PSJNOO=$$ENNOO^PSJUTL5("D") G:PSJNOO<0 EN1
     49 ;Prompt for requesting provider
     50 W ! I '$$REQPROV^PSGOEC G EN1
     51 W !
     52 ;
     53 ;F PSGOECS=1:1:PSGODDD F PSGOECS1=1:1 S PSGOECS2=$P(PSGODDD(PSGOECS),",",PSGOECS1) Q:'PSGOECS2  S (ON,PSGORD)=^TMP("PSJON",$J,PSGOECS2) D:(PSGORD["U") AC D:(PSGORD["P") NC D:(PSGORD["V") SPDCIV^PSIVSPDC
     54 ;Replaced above line with block structure below.
     55 N COMFLG,PSJCOM S (EXITLOOP,PSJCOM)=0
     56 F PSGOECS=1:1:PSGODDD D
     57 .F PSGOECS1=1:1 D  Q:EXITLOOP=1
     58 ..S PSGOECS2=$P(PSGODDD(PSGOECS),",",PSGOECS1)
     59 ..I 'PSGOECS2 S EXITLOOP=1 Q
     60 ..S (ON,PSGORD)=^TMP("PSJON",$J,PSGOECS2)
     61 ..I PSGORD=+PSGORD D DCCOM Q
     62 ..I '$$LS^PSSLOCK(DFN,PSGORD) D  Q
     63 ... W:PSGORD'["V" !,$P($$DRUGNAME^PSJLMUTL(DFN,PSGORD),"^",1),!,"NO ACTION WAS TAKEN",!,$C(7) HANG 1 Q
     64 ... W ! I PSGORD["V" N PSJLINE S PSJLINE=1 D DSPLORDV^PSJLMUT1(PSGP,PSGORD) D  W !,"NO ACTION WAS TAKEN",!,$C(7) HANG 1
     65 ....F X=0:0 S X=$O(PSJOC(ON,X)) Q:'X  D
     66 .....W !,$G(PSJOC(ON,X))
     67 ..D CHKCOM I COMFLG  D
     68 ... I PSGORD'["V" W !,$P($$DRUGNAME^PSJLMUTL(DFN,PSGORD),"^",1),!,"NO ACTION WAS TAKEN",!,$C(7) HANG 1 Q
     69 ... W ! I PSGORD["V" N PSJLINE S PSJLINE=1 D DSPLORDV^PSJLMUT1(PSGP,PSGORD) D  W !,"NO ACTION WAS TAKEN",!,$C(7) HANG 1
     70 ....F X=0:0 S X=$O(PSJOC(ON,X)) Q:'X  D
     71 .....W !,$G(PSJOC(ON,X))
     72 ..Q:PSJCOM
     73 ..D:(PSGORD["U") AC
     74 ..D:(PSGORD["P") NC
     75 ..D:(PSGORD["V") SPDCIV^PSIVSPDC
     76 ..; Call the unlock procedure
     77 ..D UNL^PSSLOCK(DFN,PSGORD)
     78 S X=""
     79RESET ;
     80 I $G(PSGORD)["V" D INIT^PSJLMHED(3) S VALMBK="R" G DONE
     81 D INIT^PSJLMHED(1) S VALMBCK="R"
     82 ;
     83DONE ;
     84 K DA,DIE,DP,DR,PSGAL,PSGALR,PSGLMT,PSGODDD,PSGOECS,PSGOECS1,PSGOECS2,PSGONW,PSGORD,PSGPOSA,PSGPOSD,PSGTOL,PSGTOO,PSGUOW,ORIFN,ORETURN,ORNATR
     85 Q
     86 ;
     87DCOR ; Create DC order/update stop date in OE/RR.
     88 S PSOC=$S(PSGORD["P":"OC",PSGORD["N":"OC",1:"OD")
     89 D EN1^PSJHL2(PSGP,PSOC,PSGORD)
     90 Q
     91 ;
     92ENOR ;
     93 K DA S PSGEDIT=$S($D(PSGEDIT):PSGEDIT,1:"D"),CF=1,PSGALR=20,DA=+PSGORD,T="" I PSGORD'["U",(PSGORD'["O") D:CF NSET^PSGOEC D NC^PSGOEC D ENOR2 G DONE^PSGOEC
     94 S DA(1)=PSGP D:CF ASET^PSGOEC D AC^PSGOEC
     95 G DONE^PSGOEC
     96 ;
     97ENOR2 ;Check to see if order being DC'd is a Pending Renewal and is being DC'd due to edit.
     98 I PSGEDIT="DE",$P(^PS(53.1,+PSGORD,0),U,25),$P(^PS(53.1,+PSGORD,0),U,24)="R",PSGSD<$P($G(^PS(55,PSGP,5,+$P(^PS(53.1,+PSGORD,0),U,25),2)),U,4) D
     99 .K DA,DR S DA(1)=PSGP,DA=+$P(^PS(53.1,+PSGORD,0),U,25),DIE="^PS(55,"_PSGP_",5,",DR="34////"_PSGSD_";25////"_$P($G(^PS(55,PSGP,5,+$P(^PS(53.1,+PSGORD,0),U,25),2)),U,4)
     100 .D ^DIE,EN1^PSJHL2(PSGP,"XX",$P(^PS(53.1,+PSGORD,0),U,25))
     101 Q
     102 ;
     103CHKCOM ;Check to see if order is part of complex order series.
     104 S PSJCOM=$S(PSGORD["V":$P($G(^PS(55,PSGP,"IV",+PSGORD,.2)),U,8),PSGORD["U":$P($G(^PS(55,PSGP,5,+PSGORD,.2)),U,8),1:$P($G(^PS(53.1,+PSGORD,.2)),U,8)),COMFLG=0
     105 N PSJSTAT S PSJSTAT=$S(PSGORD["V":$P($G(^PS(55,PSGP,"IV",+PSGORD,0)),"^",17),PSGORD["U":$P($G(^PS(55,PSGP,5,+PSGORD,0)),"^",9),1:$P($G(^PS(53.1,+PSGORD,0)),"^",9))
     106 Q:'PSJCOM  I "DE"[PSJSTAT Q
     107 W ! I PSGORD["V" N PSJLINE S PSJLINE=1 D DSPLORDV^PSJLMUT1(PSGP,PSGORD) D
     108 .F X=0:0 S X=$O(PSJOC(ON,X)) Q:'X  D
     109 ..W !,$G(PSJOC(ON,X))
     110 I PSGORD["U" W !,$P($$DRUGNAME^PSJLMUTL(PSGP,PSGORD),"^",1) D
     111 .W !!,"is part of a complex order. If you discontinue this order the following orders",!,"will be discontinued too (unless the stop date has already been reached)." D CMPLX^PSJCOM1(PSGP,PSJCOM,PSGORD)
     112 F  W !!,"Do you want to discontinue this series of complex orders" S %=1 D YN^DICN Q:%
     113 I %'=1 S COMFLG=1 Q
     114 N O,OO S O=0,OO="" F  S O=$O(^PS(55,"ACX",PSJCOM,O)) Q:'O  F  S OO=$O(^PS(55,"ACX",PSJCOM,O,OO)) Q:OO=""  D  Q:COMFLG
     115 .Q:OO=PSGORD  I '$$LS^PSSLOCK(DFN,OO) S COMFLG=1 Q
     116 Q:COMFLG
     117 N O,OO S O=0,OO="" F  S O=$O(^PS(55,"ACX",PSJCOM,O)) Q:'O  F  S OO=$O(^PS(55,"ACX",PSJCOM,O,OO)) Q:OO=""  D
     118 .I (OO["U") N PSGORD S PSGORD=OO D AC
     119 .I (OO["V") N PSGORD S (ON,PSGORD)=OO D SPDCIV^PSIVSPDC
     120 .D UNL^PSSLOCK(DFN,PSGORD)
     121 Q
     122 ;
     123DCCOM ;DC pending/non-verified complex order
     124 I '$$LOCK^PSJOEA(DFN,PSGORD) W !,"Order # ",PSGOECS2," could not be discontinued.",!,$C(7) HANG 1 Q
     125 N PSGORD1 S PSGORD1=PSGORD
     126 N PSJO S PSJO=0 F  S PSJO=$O(^PS(53.1,"ACX",PSGORD1,PSJO)) Q:'PSJO  S PSGORD=PSJO_"P" D NC
     127 Q
Note: See TracChangeset for help on using the changeset viewer.