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

    r613 r623  
    1 PSIVORC1        ;BIR/MLM-PROCESS INCOMPLETE IV ORDER - CONT ;13 Jan 98 / 11:36 AM
    2         ;;5.0; INPATIENT MEDICATIONS ;**1,37,69,110,157,134**;16 DEC 97;Build 124
    3         ;
    4         ; Reference to ^DD("DD" is supported by DBIA 10017.
    5         ; Reference to ^DD( is supported by DBIA 2255.
    6         ; Reference to ^VA(200 is supported by DBIA 10060.
    7         ; Reference to ^%DT is supported by DBIA 10003.
    8         ; Reference to ^%DTC is supported by DBIA 10000.
    9         ; Reference to ^DID is supported by DBIA 2052.
    10         ; Reference to ^VALM is supported by DBIA 10118.
    11         ; Reference to ^PS(55 is supported by DBIA# 2191.
    12         ;
    13 53      ; IV Type
    14         I $G(PSGORD)["P",$G(PSGAT),($G(P(9))]"") D
    15         .N X,PSGS0Y,ZZ,LYN,ZZND,ZZNDW S X=P(9) S PSGS0Y="",ZZ=0 D FIND^DIC(51.1,,,,X,,"APPSJ",,,"LYN")
    16         .S ZZ=$O(LYN("DILIST",2,ZZ)) I ZZ S ZZ=+LYN("DILIST",2,ZZ) I ZZ S ZZND=$G(^PS(51.1,ZZ,0)) S PSGST=$P(ZZND,U,5),PSGS0XT=$P(ZZND,U,3) I $G(PSJPWD) D
    17         ..N ZZNDW S ZZNDW=$G(^PS(51.1,ZZ,1,PSJPWD,0)) I $P(ZZNDW,"^",2)]"" S PSGS0Y=$P(ZZNDW,"^",2),$P(ZZND,"^",2)=PSGS0Y
    18         .S ZZ=0 F  S ZZ=$O(LYN("DILIST",1,ZZ)) Q:'ZZ  I $G(LYN("DILIST",1,ZZ))'=X K LYN("DILIST",1,ZZ),LYN("DILIST",2,ZZ),LYN("DILIST","ID",ZZ,1)
    19         .I $D(PSJPWD) S ZZ=0 F  S ZZ=$O(LYN("DILIST",2,ZZ)) Q:'ZZ  I $P($G(^PS(51.1,+LYN("DILIST",2,ZZ),1,+PSJPWD,0)),U,2)]"" S PSGS0Y=$P($G(^(0)),U,2)
    20         .I '$G(PSGS0Y) S ZZ=0 F  S ZZ=$O(LYN("DILIST",2,ZZ)) Q:'ZZ  Q:PSGS0Y]""  I $G(LYN("DILIST","ID",ZZ,1))]"" S PSGS0Y=$G(LYN("DILIST","ID",ZZ,1))
    21         .Q:(PSGS0Y=PSGAT)!'$G(PSGS0Y)!($G(IVCAT)="C")
    22         .S PSGNSTAT=1 W $C(7),!!,"PLEASE NOTE:  This order's admin times (",PSGAT,")"
    23         .W !?13," do not match the ward times (",PSGS0Y,")"
    24         .W !?13," for this administration schedule (",P(9),")",!
    25         .S DIR(0)="EA",DIR("A")="Press Return to continue..." D ^DIR K DIR  W !
    26         S DONE=0 N DIR S DIR(0)="SNA^A:ADMIXTURE;C:CHEMOTHERAPY;H:HYPERAL;P:PIGGYBACK;S:SYRINGE",DIR("A")="IV TYPE: "
    27         I $G(P("RES"))'="R",$G(PSGORD)["P" N IVCAT,IVTYPTMP S IVCAT=$P($G(^PS(53.1,+PSGORD,2.5)),"^",5) S IVTYPTMP=$S((P(9)]""):"P",$G(P(5)):"P",$G(P(23))="P":"P",1:"")
    28         S DIR("B")=$S($G(IVCAT)="C"!($G(IVTYPTMP)="A"):"ADMIXTURE",$G(IVCAT)="I"!($G(IVTYPTMP)="P"):"PIGGYBACK",1:"ADMIXTURE")
    29         D DIRQ,^DIR S:$D(DTOUT)!(X="^") DONE=1 Q:DONE  G:$E(X)="^" 53 S P(4)=Y D:"CS"[P(4) @P(4)
    30         I PSIVAC'="PN" D ENT^PSIVCAL K %DT S X=P(2),%DT="RTX" D ^%DT S P(2)=+Y D ENSTOP^PSIVCAL K %DT S X=P(3),%DT="RTX" D ^%DT S P(3)=+Y
    31 OTYP    ; Get order type, display type.
    32         S P("DTYP")=$S(P(4)="":0,P(4)="P"!(P(23)="P")!(P(5)):1,P(4)="H":2,1:3) S:PSIVAC'="CF" P("OT")=$S(P(4)="A":"F",P(4)="H":"H",1:"I")
    33         Q
    34         ;
    35 C       ; Edit Chemo order
    36         N DIR S DIR(0)="SA^A:ADMIXTURE;P:PIGGYBACK;S:SYRINGE",DIR("A")="CHEMOTHERAPY TYPE: " D DIRQ,^DIR S:$D(DTOUT)!(X=U) DONE=1 Q:$E(X)="^"!(DONE)  S P(23)=Y D:P(23)["S" S
    37         Q
    38         ;
    39 S       ; Edit Syringe order
    40 56      ; Intermittent Syringe
    41         N DIR S DIR(0)="Y",DIR("??")="^S F1=53.1,F2=56 D ENHLP^PSIVORC1",DIR("A")="INTERMITTENT SYRINGE" D ^DIR Q:$D(DIRUT)  S P(5)=Y
    42         ;
    43 55      ; Syringe Size
    44         N DA,DIR S DIR(0)="53.1,55" D ^DIR I $D(DTOUT)!$D(DUOUT) S DONE=1 Q
    45         S P("SYRS")=Y
    46         Q
    47         ;
    48 DIRQ    ; Set DIR("?") for IV Type prompt.
    49         S DIR("?")="Enter a code from the list above.",DIR("??")="^S F1=55.01,F2="_$S(DIR("A")["CHEMO":106,1:.04)_" D ENHLP^PSIVORC1"
    50         S DIR("?",1)="CHOOSE FROM:",Y=$P(DIR(0),U,2) F X=1:1:5 S DIR("?",X+1)="              "_$P($P(Y,";",X),":")_"    "_$P($P(Y,";",X),":",2)
    51         Q
    52         ;
    53 CKFLDS  ; Find required fields missing data.
    54         NEW PSIVASX,PSIVASY,FIL,DRGTMP
    55         S EDIT="" F PSIVASX="AD","SOL" D
    56         .I '$D(DRG(PSIVASX)) S EDIT=EDIT_U_$S(PSIVASX="AD":57,1:58) Q
    57         .S DNE=0 F PSIVASY=0:0 S PSIVASY=$O(DRG(PSIVASX,PSIVASY)) Q:'PSIVASY!DNE  D
    58         .. I $P(DRG(PSIVASX,PSIVASY),U,3)="" S EDIT=EDIT_U_$S(PSIVASX="AD":57,1:58),DNE=1
    59         S:'P("MR") EDIT=EDIT_U_3 F X=8,6,2,3 I P(X)="" S EDIT=EDIT_U_$S(X=8:59,X=6:1,X=2:10,X=3:25,1:"")
    60         I P("DTYP")=1 S:P(9)="" EDIT=EDIT_U_26 S:P(11)="" EDIT=EDIT_U_39
    61         S:$E(EDIT,1)=U EDIT=$E(EDIT,2,999)
    62         Q
    63         ;
    64 DONE    ; Kill variables and exit
    65         K ACTION,AD,DFN,DNE,DONE,DONE1,DRG,DRGI,DRGN,DRGT,DRGTN,EDIT,ERR,F1,F2,FIL,HDT,J,LN,LN2,ND,ON,ON1,ON55,ORIFN,P,P16,PC,PDM,PG,PN,PNME,PNOW,PSGLMT,PSGODDD
    66         K PSGSS,PSGSSH,PSIV,PSIVAC,PSIVAT,PSIVCV,PSIVE,PSIVHD,PSIVLN,PSIVOK,PSIVOLD,PSIVORUT,PSIVREA,PSIVSC1,PSIVSTR,PSIVSTRT,PSIVTYPE,PSIVUP,PSIVX,PSIVX1
    67         K PSJIVORF,PSJORF,PSJORIFN,PSJORL,PSJORNP,PSJORPF,PSJORSTS,PSJIVOF,PSJNKF,PSJORD,RB,RF,SOL,STOP,TYP,UL80,WD,WDN,WG,^TMP("PSIV",$J) D ENIVKV^PSGSETU
    68         Q
    69 ENHLP   ; order entry fields' help
    70         N PSJHP,PSJX,PSJD
    71         ; From within this routine, F1 and F2 will refer to file 53.1,field 56, file 55.01,field 106, or file 55.01,field .04
    72         D FIELD^DID(F1,F2,"","HELP-PROMPT","PSJHP")
    73         I X="?",$D(PSJHP("HELP-PROMPT")) S F=$G(PSJHP("HELP-PROMPT")) W !?5 F F0=1:1:$L(F," ") S F3=$P(F," ",F0) W:$L(F3)+$X>78 !?5 W F3_" "
    74         ;
    75         W:$D(^DD(F1,F2,12)) !,"("_^(12)_")" D FIELD^DID(F1,F2,"","XECUTABLE HELP","PSJX") I $D(PSJX("XECUTABLE HELP")) X PSJX("XECUTABLE HELP")
    76         ;
    77         ; new code
    78         D FIELD^DID(F1,F2,"","DESCRIPTION","PSJD")
    79         G:$S($G(X)="?":1,1:'$O(PSJD("DESCRIPTION",0))) SC F F=0:0 S F=$O(PSJD("DESCRIPTION",F)) Q:'F  I $D(PSJD("DESCRIPTION",F)) W !?2,PSJD("DESCRIPTION",F)
    80 SC      ;
    81         I F2=5!(F2=6) W !,"CHOOSE FROM:",!?8,0,?16,"NO",!?8,1,?16,"YES" Q
    82         Q
    83 COMPLTE ;
    84         S P16=0,PSIVEXAM=1,(PSIVNOL,PSIVCT)=1 D GTOT^PSIVUTL(P(4)) D ^PSIVCHK I $D(DUOUT) W $C(7),!,"Order Unchanged.",! Q
    85         G:'$D(PSIVFN1) EDIT1
    86         I ERR=1 S Y=0 G EDIT1
    87         D CKORD^PSIVORC2 I PSIVCHG D NOW^%DTC S P("LOG")=$E(%,1,12),P("CLRK")=DUZ_U_$P($G(^VA(200,DUZ,0)),U),P("INS")=""
    88         W ! D ^PSIVORLB K PSIVEXAM S Y=P(2)
    89         W !,"Start date: " X ^DD("DD") W $P(Y,"@")," ",$P(Y,"@",2),?30," Stop date: " S Y=P(3) X ^DD("DD") W $P(Y,"@")," ",$P(Y,"@",2),!
    90 EDIT    ;
    91         I ERR=1 W !,"Please re-edit this order" K DIR S DIR(0)="E" D ^DIR K DIR W:'Y $C(7),"order unchanged." Q:'Y  S Y=0 G EDIT1
    92         ;PSJ*5*157 EFD FOR IV
    93         D EFDIV^PSJUTL($G(ZZND))
    94         W:$G(PSIVCHG) !,"*** This change will cause a new order to be created. ***"
    95         K DIR S DIR(0)="Y",DIR("A")="Is this O.K.",DIR("B")=$S(ERR:"NO",1:"YES"),DIR("?",1)="Enter ""Y"" to make this an active order (only allowed if no errors were"
    96         S DIR("?")="found in order), ""N"" to edit the order, or ""^"" to leave order unchanged.",DIR("??")="^S HELP=""EDIT"" D ^PSIVHLP"
    97         D ^DIR K DIR I $D(DIRUT) K DIRUT W $C(7),"Order unchanged." Q
    98         ;*  Kill Unit dose variables when calling from ^PSJLIFNI.
    99         I +Y,$G(PSJLIFNI) D
    100         . K ND,ND4,ND6,NDP2
    101         . K PSGAT,PSGCANFL,PSGDI,PSGDO,PSGDT,PSGEB,PSGEBN,PSGEFN,PSGFD,PSGFDN
    102         . K PSGHSM,PSGLI,PSGLIN,PSGLMT,PSGMR,PSGMRN,PSGNEDFD,PSGNEF,PSGNEFD
    103         . K PSGNESD,PSGOAT,PSGODO,PSGODT,PSGEA,PSGOEAV,PSGOEEF
    104         . K PSGOEEWF,PSGOEEG,PSGOEF,PSGOENG,PSGOES,PSGOFD,PSGOFDN,PSGOHSM
    105         . K PSGOINST,PSGOMR,PSGOMRN,PSGONC
    106         . K PSGOPD,PSOPDN,PSGOPR,PSGOPRN,PSGOSD,PSGOSDN,PSGOSI,PSGOSM
    107         . K PSGOST,PSGOSTN
    108         . K PSGPD,PSGPDN,PSGPDRG,PSGDRGN,PSGPFLG,PSGPI,PSGPR,PSGPRIO,PSGPRN
    109         . K PSGPTMP,PSGRRF,PSG0XT,PSGS0Y,PSGSCH,PSGSD,PSGSDN,PSGSI,PSGSM
    110         . K PSGST,PSGSTAT,PSGSTN,PSJACNWP,PSJACOK,PSJCOI
    111 EDIT1   ;
    112         NEW XFLG,PSIVY S PSIVY=Y
    113         NEW X S X=^TMP("PSJI",$J,0),VALMBG=$S((X<17):1,1:(X-(X#16)))
    114         I PSIVY=0!'$G(PSIVFN1) S PSIVFN1=1 D EN^VALM("PSJ LM IV AC/EDIT") Q
    115         S PSIVCHG=0 D EDCHK^PSIVORC2 K PSIVCHG
    116         S VALMBCK="Q",PSIVACEP=1
    117         Q
     1PSIVORC1 ;BIR/MLM-PROCESS INCOMPLETE IV ORDER - CONT ;13 Jan 98 / 11:36 AM
     2 ;;5.0; INPATIENT MEDICATIONS ;**1,37,69,110,157**;16 DEC 97
     3 ;
     4 ; Reference to ^DD("DD" is supported by DBIA 10017.
     5 ; Reference to ^DD( is supported by DBIA 2255.
     6 ; Reference to ^VA(200 is supported by DBIA 10060.
     7 ; Reference to ^%DT is supported by DBIA 10003.
     8 ; Reference to ^%DTC is supported by DBIA 10000.
     9 ; Reference to ^DID is supported by DBIA 2052.
     10 ; Reference to ^VALM is supported by DBIA 10118.
     11 ;
     1253 ; IV Type
     13 ;*S DONE=0 N DIR S DIR(0)="SNA^A:ADMIXTURE;C:CHEMOTHERAPY;"_$S($E(PSIVAC)'["C":"H:HYPERAL;",1:"")_"P:PIGGYBACK;S:SYRINGE",DIR("A")="IV TYPE: "
     14 S DONE=0 N DIR S DIR(0)="SNA^A:ADMIXTURE;C:CHEMOTHERAPY;H:HYPERAL;P:PIGGYBACK;S:SYRINGE",DIR("A")="IV TYPE: "
     15 I $G(P("RES"))'="R" S:P(4)]"" DIR("B")="ADMIXTURE",P(4)=""
     16 D DIRQ,^DIR S:$D(DTOUT)!(X="^") DONE=1 Q:DONE  G:$E(X)="^" 53 S P(4)=Y D:"CS"[P(4) @P(4)
     17 I PSIVAC'="PN" D ENT^PSIVCAL K %DT S X=P(2),%DT="RTX" D ^%DT S P(2)=+Y D ENSTOP^PSIVCAL K %DT S X=P(3),%DT="RTX" D ^%DT S P(3)=+Y
     18OTYP ; Get order type, display type.
     19 S P("DTYP")=$S(P(4)="":0,P(4)="P"!(P(23)="P")!(P(5)):1,P(4)="H":2,1:3) S:PSIVAC'="CF" P("OT")=$S(P(4)="A":"F",P(4)="H":"H",1:"I")
     20 Q
     21 ;
     22C ; Edit Chemo order
     23 N DIR S DIR(0)="SA^A:ADMIXTURE;P:PIGGYBACK;S:SYRINGE",DIR("A")="CHEMOTHERAPY TYPE: " D DIRQ,^DIR S:$D(DTOUT)!(X=U) DONE=1 Q:$E(X)="^"!(DONE)  S P(23)=Y D:P(23)["S" S
     24 Q
     25 ;
     26S ; Edit Syringe order
     2756 ; Intermittent Syringe
     28 N DIR S DIR(0)="Y",DIR("??")="^S F1=53.1,F2=56 D ENHLP^PSIVORC1",DIR("A")="INTERMITTENT SYRINGE" D ^DIR Q:$D(DIRUT)  S P(5)=Y
     29 ;
     3055 ; Syringe Size
     31 N DA,DIR S DIR(0)="53.1,55" D ^DIR I $D(DTOUT)!$D(DUOUT) S DONE=1 Q
     32 S P("SYRS")=Y
     33 Q
     34 ;
     35DIRQ ; Set DIR("?") for IV Type prompt.
     36 S DIR("?")="Enter a code from the list above.",DIR("??")="^S F1=55.01,F2="_$S(DIR("A")["CHEMO":106,1:.04)_" D ENHLP^PSIVORC1"
     37 S DIR("?",1)="CHOOSE FROM:",Y=$P(DIR(0),U,2) F X=1:1:5 S DIR("?",X+1)="              "_$P($P(Y,";",X),":")_"    "_$P($P(Y,";",X),":",2)
     38 Q
     39 ;
     40CKFLDS ; Find required fields missing data.
     41 NEW PSIVASX,PSIVASY,FIL,DRGTMP
     42 S EDIT="" F PSIVASX="AD","SOL" D
     43 .I '$D(DRG(PSIVASX)) S EDIT=EDIT_U_$S(PSIVASX="AD":57,1:58) Q
     44 .S DNE=0 F PSIVASY=0:0 S PSIVASY=$O(DRG(PSIVASX,PSIVASY)) Q:'PSIVASY!DNE  D
     45 .. I $P(DRG(PSIVASX,PSIVASY),U,3)="" S EDIT=EDIT_U_$S(PSIVASX="AD":57,1:58),DNE=1
     46 .. ;S FIL=$S(PSIVASX="AD":"52.6",1:"52.7")
     47 .. ;S DRGTMP=DRG(PSIVASX,PSIVASY) D ORDERCHK^PSIVEDRG(DFN)
     48 S:'P("MR") EDIT=EDIT_U_3 F X=8,6,2,3 I P(X)="" S EDIT=EDIT_U_$S(X=8:59,X=6:1,X=2:10,X=3:25,1:"")
     49 I P("DTYP")=1 S:P(9)="" EDIT=EDIT_U_26 S:P(11)="" EDIT=EDIT_U_39
     50 S:$E(EDIT,1)=U EDIT=$E(EDIT,2,999)
     51 Q
     52 ;
     53DONE ; Kill variables and exit
     54 K ACTION,AD,DFN,DNE,DONE,DONE1,DRG,DRGI,DRGN,DRGT,DRGTN,EDIT,ERR,F1,F2,FIL,HDT,J,LN,LN2,ND,ON,ON1,ON55,ORIFN,P,P16,PC,PDM,PG,PN,PNME,PNOW,PSGLMT,PSGODDD
     55 K PSGSS,PSGSSH,PSIV,PSIVAC,PSIVAT,PSIVCV,PSIVE,PSIVHD,PSIVLN,PSIVOK,PSIVOLD,PSIVORUT,PSIVREA,PSIVSC1,PSIVSTR,PSIVSTRT,PSIVTYPE,PSIVUP,PSIVX,PSIVX1
     56 K PSJIVORF,PSJORF,PSJORIFN,PSJORL,PSJORNP,PSJORPF,PSJORSTS,PSJIVOF,PSJNKF,PSJORD,RB,RF,SOL,STOP,TYP,UL80,WD,WDN,WG,^TMP("PSIV",$J) D ENIVKV^PSGSETU
     57 Q
     58ENHLP ; order entry fields' help
     59 N PSJHP,PSJX,PSJD
     60 ;
     61 D FIELD^DID(F1,F2,"","HELP-PROMPT","PSJHP")
     62 I X="?",$D(PSJHP("HELP-PROMPT")) S F=$G(PSJHP("HELP-PROMPT")) W !?5 F F0=1:1:$L(F," ") S F3=$P(F," ",F0) W:$L(F3)+$X>78 !?5 W F3_" "
     63 ;I X="?",$D(^DD(F1,F2,3)) S F=^(3) W !?5 F F0=1:1:$L(F," ") S F3=$P(F," ",F0) W:$L(F3)+$X>78 !?5 W F3_" "
     64 ;
     65 W:$D(^DD(F1,F2,12)) !,"("_^(12)_")" D FIELD^DID(F1,F2,"","XECUTABLE HELP","PSJX") I $D(PSJX("XECUTABLE HELP")) X PSJX("XECUTABLE HELP")
     66 ;
     67 ; new code
     68 D FIELD^DID(F1,F2,"","DESCRIPTION","PSJD")
     69 G:$S($G(X)="?":1,1:'$O(PSJD("DESCRIPTION",0))) SC F F=0:0 S F=$O(PSJD("DESCRIPTION",F)) Q:'F  I $D(PSJD("DESCRIPTION",F)) W !?2,PSJD("DESCRIPTION",F)
     70SC ;
     71 I F2=5!(F2=6) W !,"CHOOSE FROM:",!?8,0,?16,"NO",!?8,1,?16,"YES" Q
     72 Q
     73COMPLTE ;
     74 S P16=0,PSIVEXAM=1,(PSIVNOL,PSIVCT)=1 D GTOT^PSIVUTL(P(4)) D ^PSIVCHK I $D(DUOUT) W $C(7),!,"Order Unchanged.",! Q
     75 G:'$D(PSIVFN1) EDIT1
     76 I ERR=1 S Y=0 G EDIT1
     77 D CKORD^PSIVORC2 I PSIVCHG D NOW^%DTC S P("LOG")=$E(%,1,12),P("CLRK")=DUZ_U_$P($G(^VA(200,DUZ,0)),U),P("INS")=""
     78 W ! D ^PSIVORLB K PSIVEXAM S Y=P(2)
     79 W !,"Start date: " X ^DD("DD") W $P(Y,"@")," ",$P(Y,"@",2),?30," Stop date: " S Y=P(3) X ^DD("DD") W $P(Y,"@")," ",$P(Y,"@",2),!
     80EDIT ;
     81 I ERR=1 W !,"Please re-edit this order" K DIR S DIR(0)="E" D ^DIR K DIR W:'Y $C(7),"order unchanged." Q:'Y  S Y=0 G EDIT1
     82 ;PSJ*5*157 EFD FOR IV
     83 D EFDIV^PSJUTL($G(ZZND))
     84 W:$G(PSIVCHG) !,"*** This change will cause a new order to be created. ***"
     85 K DIR S DIR(0)="Y",DIR("A")="Is this O.K.",DIR("B")=$S(ERR:"NO",1:"YES"),DIR("?",1)="Enter ""Y"" to make this an active order (only allowed if no errors were"
     86 S DIR("?")="found in order), ""N"" to edit the order, or ""^"" to leave order unchanged.",DIR("??")="^S HELP=""EDIT"" D ^PSIVHLP"
     87 D ^DIR K DIR I $D(DIRUT) K DIRUT W $C(7),"Order unchanged." Q
     88 ;*  Kill Unit dose variables when calling from ^PSJLIFNI.
     89 I +Y,$G(PSJLIFNI) D
     90 . K ND,ND4,ND6,NDP2
     91 . K PSGAT,PSGCANFL,PSGDI,PSGDO,PSGDT,PSGEB,PSGEBN,PSGEFN,PSGFD,PSGFDN
     92 . K PSGHSM,PSGLI,PSGLIN,PSGLMT,PSGMR,PSGMRN,PSGNEDFD,PSGNEF,PSGNEFD
     93 . K PSGNESD,PSGOAT,PSGODO,PSGODT,PSGEA,PSGOEAV,PSGOEEF
     94 . K PSGOEEWF,PSGOEEG,PSGOEF,PSGOENG,PSGOES,PSGOFD,PSGOFDN,PSGOHSM
     95 . K PSGOINST,PSGOMR,PSGOMRN,PSGONC
     96 . K PSGOPD,PSOPDN,PSGOPR,PSGOPRN,PSGOSD,PSGOSDN,PSGOSI,PSGOSM
     97 . K PSGOST,PSGOSTN
     98 . K PSGPD,PSGPDN,PSGPDRG,PSGDRGN,PSGPFLG,PSGPI,PSGPR,PSGPRIO,PSGPRN
     99 . K PSGPTMP,PSGRRF,PSG0XT,PSGS0Y,PSGSCH,PSGSD,PSGSDN,PSGSI,PSGSM
     100 . K PSGST,PSGSTAT,PSGSTN,PSJACNWP,PSJACOK,PSJCOI
     101EDIT1 ;
     102 NEW XFLG,PSIVY S PSIVY=Y
     103 NEW X S X=^TMP("PSJI",$J,0),VALMBG=$S((X<17):1,1:(X-(X#16)))
     104 I PSIVY=0!'$G(PSIVFN1) S PSIVFN1=1 D EN^VALM("PSJ LM IV AC/EDIT") Q
     105 S PSIVCHG=0 D EDCHK^PSIVORC2 K PSIVCHG
     106 S VALMBCK="Q",PSIVACEP=1
     107 Q
Note: See TracChangeset for help on using the changeset viewer.