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

    r613 r623  
    1 PSJOERI ;BIR/LDT-CPRS ORDER UPDATE FOR INPATIENT MEDS ; 7/30/08 7:51am
    2         ;;5.0; INPATIENT MEDICATIONS ;**86,108,204**;16 DEC 97;Build 3
    3         ;
    4         ; Reference to ^PS(55 is supported by DBIA 2191
    5         ; Reference to ^%DTC is supported by DBIA 10000
    6         ; Reference to ^DIE is supported by DBIA 10018
    7         ;
    8 ENR(DFN,ON,PSJWARD)     ;
    9         I $G(DFN)=""!($G(ON)="")!(+$G(PSJWARD)'>0) Q
    10         I PSJWARD'=+PSJWARD Q
    11         D NOW^%DTC S PSJNOW=%
    12         I ON["V" D  Q
    13         . I '$D(^PS(55,DFN,"IV",+ON)) Q
    14         . I $P(^PS(55,DFN,"IV",+ON,0),"^",17)'="D" Q
    15         . I $P(^PS(55,DFN,"IV",+ON,0),"^",12)="" Q
    16         . N DA,DR,DIE,DIK,PSIVREA,PSIVALCK,PSIVOPT,PSIVAL,PSIVALT,X,Y
    17         . S P(3)=$P($G(^PS(55,DFN,"IV",+ON,0)),"^",3)
    18         . S X=$G(^PS(55,DFN,"IV",+ON,"ADC")) I X K ^PS(55,"ADC",X,DFN,+ON),^PS(55,DFN,"IV",+ON,"ADC")
    19         . S PSIVACT=1,DR="100///A;.03////"_+$P($G(^PS(55,DFN,"IV",+ON,2)),U,7)_";9////^S X=PSJWARD;109///@;116///@;121///@",DIE="^PS(55,"_DFN_",""IV"",",DA=+ON,DA(1)=DFN
    20         .;PSJ*5.0*204
    21         . I $P($G(^PS(55,DFN,"IV",+ON,4)),"^",18)=1 S DR="100////H;.03////"_+$P($G(^PS(55,DFN,"IV",+ON,2)),U,7)_";9////^S X=PSJWARD;109///@;116///@;121///@"
    22         . N CHKIT S CHKIT=$G(^PS(55,DFN,"IV",+ON,2)) I $P(CHKIT,U,6)["P",($P(CHKIT,U,9)="R") S DR=DR_";114///@;123///@"
    23         . D ^DIE
    24         . D IRA(1),EN1^PSJHL2(DFN,"SC",ON,"AUTO REINSTATED (CPRS)")
    25         I ON["U" D  Q
    26         . I '$D(^PS(55,DFN,5,+ON)) Q
    27         . I $P(^PS(55,DFN,5,+ON,0),"^",9)'="D" Q
    28         . I $P(^PS(55,DFN,5,+ON,4),"^",11)="" Q
    29         . N DA,DR,DIE,PSGFD,X,Z
    30         . S PSGFD=$P($G(^PS(55,DFN,5,+ON,2)),"^",3)
    31         . S DR="28////A;34////^S X=PSGFD;68////^S X=PSJWARD",Z=$G(^PS(55,DFN,5,+ON,4)),$P(Z,U,11)="",$P(Z,"^",15,17)="^^" S ^(4)=Z
    32         .;PSJ*5.0*204
    33         . I $P($G(^PS(55,DFN,5,+ON,4)),"^",18)=1 S DR="28////H;34////^S X=PSGFD;68////^S X=PSJWARD"
    34         . N CHKIT S CHKIT=$G(^PS(55,DFN,5,+ON,0)) I $P(CHKIT,U,26)["P",($P(CHKIT,U,27)="R") S DR=DR_";105///@;107///@"
    35         . S DIE="^PS(55,"_DFN_",5,",DA(1)=DFN,DA=+ON D ^DIE
    36         . S X=$P(^PS(55,DFN,5,+ON,0),"^",20),$P(^(0),"^",20)="" K:X ^PS(55,"AUDDD",X,DFN,+ON) ;Removed cross reference after reinstate order.
    37         . D URA(1),EN1^PSJHL2(DFN,"SC",ON,"AUTO REINSTATED (CPRS)")
    38         Q
    39 IRA(STAT)       ;
    40         S ON55=ON,P(17)="A",PSIVREA="AI",PSIVALCK="STOP",(PSIVOPT,PSIVALT)=1,PSJUNDC=1,PSIVAL="AUTO REINSTATED (CPRS)"
    41         D LOG^PSIVORAL
    42         Q
    43 URA(STAT)       ;
    44         S PSGAL("C")=18560 D ^PSGAL5
    45         Q
     1PSJOERI ;BIR/LDT-CPRS ORDER UPDATE FOR INPATIENT MEDS ;18 JUN 01
     2 ;;5.0; INPATIENT MEDICATIONS ;**86,108**;16 DEC 97
     3 ;
     4 ; Reference to ^PS(55 is supported by DBIA 2191
     5 ; Reference to ^%DTC is supported by DBIA 10000
     6 ; Reference to ^DIE is supported by DBIA 10018
     7 ;
     8ENR(DFN,ON,PSJWARD) ;
     9 I $G(DFN)=""!($G(ON)="")!(+$G(PSJWARD)'>0) Q
     10 I PSJWARD'=+PSJWARD Q
     11 D NOW^%DTC S PSJNOW=%
     12 I ON["V" D  Q
     13 . I '$D(^PS(55,DFN,"IV",+ON)) Q
     14 . I $P(^PS(55,DFN,"IV",+ON,0),"^",17)'="D" Q
     15 . I $P(^PS(55,DFN,"IV",+ON,0),"^",12)="" Q
     16 . N DA,DR,DIE,DIK,PSIVREA,PSIVALCK,PSIVOPT,PSIVAL,PSIVALT,X,Y
     17 . S P(3)=$P($G(^PS(55,DFN,"IV",+ON,0)),"^",3)
     18 . S X=$G(^PS(55,DFN,"IV",+ON,"ADC")) I X K ^PS(55,"ADC",X,DFN,+ON),^PS(55,DFN,"IV",+ON,"ADC")
     19 . S PSIVACT=1,DR="100///A;.03////"_+$P($G(^PS(55,DFN,"IV",+ON,2)),U,7)_";9////^S X=PSJWARD;109///@;116///@;121///@",DIE="^PS(55,"_DFN_",""IV"",",DA=+ON,DA(1)=DFN
     20 . N CHKIT S CHKIT=$G(^PS(55,DFN,"IV",+ON,2)) I $P(CHKIT,U,6)["P",($P(CHKIT,U,9)="R") S DR=DR_";114///@;123///@"
     21 . D ^DIE
     22 . D IRA(1),EN1^PSJHL2(DFN,"SC",ON,"AUTO REINSTATED (CPRS)")
     23 I ON["U" D  Q
     24 . I '$D(^PS(55,DFN,5,+ON)) Q
     25 . I $P(^PS(55,DFN,5,+ON,0),"^",9)'="D" Q
     26 . I $P(^PS(55,DFN,5,+ON,4),"^",11)="" Q
     27 . N DA,DR,DIE,PSGFD,X,Z
     28 . S PSGFD=$P($G(^PS(55,DFN,5,+ON,2)),"^",3)
     29 . S DR="28////A;34////^S X=PSGFD;68////^S X=PSJWARD",Z=$G(^PS(55,DFN,5,+ON,4)),$P(Z,U,11)="",$P(Z,"^",15,17)="^^" S ^(4)=Z
     30 . N CHKIT S CHKIT=$G(^PS(55,DFN,5,+ON,0)) I $P(CHKIT,U,26)["P",($P(CHKIT,U,27)="R") S DR=DR_";105///@;107///@"
     31 . S DIE="^PS(55,"_DFN_",5,",DA(1)=DFN,DA=+ON D ^DIE
     32 . S X=$P(^PS(55,DFN,5,+ON,0),"^",20),$P(^(0),"^",20)="" K:X ^PS(55,"AUDDD",X,DFN,+ON) ;Removed cross reference after reinstate order.
     33 . D URA(1),EN1^PSJHL2(DFN,"SC",ON,"AUTO REINSTATED (CPRS)")
     34 Q
     35IRA(STAT) ;
     36 S ON55=ON,P(17)="A",PSIVREA="AI",PSIVALCK="STOP",(PSIVOPT,PSIVALT)=1,PSJUNDC=1,PSIVAL="AUTO REINSTATED (CPRS)"
     37 D LOG^PSIVORAL
     38 Q
     39URA(STAT) ;
     40 S PSGAL("C")=18560 D ^PSGAL5
     41 Q
Note: See TracChangeset for help on using the changeset viewer.