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/PHARMACY_DATA_MANAGEMENT-PSS/PSS51P2.m

    r613 r623  
    1 PSS51P2 ;BIR/LDT - API FOR INFORMATION FROM FILE 51.2 ; 5 Sep 03
    2         ;;1.0;PHARMACY DATA MANAGEMENT;**85,112,118,88,94**;9/30/97;Build 26
    3         ;
    4 ALL(PSSIEN,PSSFT,PSSFL,PSSPK,LIST)      ;
    5         ;PSSIEN - IEN of entry in MEDICATION ROUTES file (#51.2).
    6         ;PSSFT - Free Text name in MEDICATION ROUTES file (#51.2).
    7         ;PSSFL - Inactive flag - "" - All entries
    8         ;        FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
    9         ;PSSPK - PACKAGE USE field (#3) of the MEDICATION ROUTES file (#51.2).
    10         ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is
    11         ;the Field Number of the data piece being returned.
    12         ;Returns NAME field (#.01), ABBREVIATION field (#1), PACKAGE USE field (#3), OUTPATIENT EXPANSION field (#4),
    13         ;OTHER LANGUAGE EXPANSION field (#4.1), INACTIVATION DATE field (#5), and IV FLAG field (#6)
    14         ;of MEDICATION ROUTES file (#51.2).
    15         N DIERR,ZZERR,PSS51P2,SCR,PSS,PSSBGCNT,PSSCNT,PSSTIEN,PSSTMP,PSSNAM,PSSCAP
    16         S PSSBGCNT=0
    17         S SCR("S")=""
    18         I $G(LIST)']"" Q
    19         K ^TMP("DILIST",$J)
    20         K ^TMP($J,LIST)
    21         I +$G(PSSIEN)'>0,($G(PSSFT)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
    22         S SCR("S")=""
    23         I +$G(PSSFL)>0 N ND D SETSCRN
    24         ;Naked reference below refers to ^PS(51.2,+Y,0)
    25         I $G(PSSPK)]"" S SCR("S")=$S(SCR("S")]"":SCR("S")_" I $P($G(^(0)),U,4)=$G(PSSPK)",1:"I $P($G(^(0)),U,4)=$G(PSSPK)")
    26         I +$G(PSSIEN)>0 N PSSIEN2 S PSSIEN2=$$FIND1^DIC(51.2,"","A","`"_PSSIEN,,SCR("S"),"") D  D COUNTBG Q
    27         .I PSSIEN2>0 D DIRREAD
    28         I +$G(PSSIEN)=0 D
    29         .I PSSFT="??" D LOOPDIR D COUNTBG Q
    30         .D FIND^DIC(51.2,,"@;.01;1","QP",PSSFT,,"B^C",SCR("S"),,"") D LOOPDI D COUNTBG
    31         Q
    32         ;
    33 COUNTBG ;CHECKS PSSBGCNT AND FILLS COUNT IN ON 0 NODE OF ^TMP($J,LIST)
    34         I PSSBGCNT>0 D
    35         .S ^TMP($J,LIST,0)=PSSBGCNT
    36         ELSE  S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND"
    37         Q
    38         ;
    39 LOOPDI  ;LOOPS ON "DILIST" FROM FILEMAN CALL (USED FOR RETURNING MULTIPLE DRUGS FROM PSSFT)
    40         S PSSTIEN=0 ;TEMP IEN TO ITERATE OVER DILIST
    41         F  S PSSTIEN=$O(^TMP("DILIST",$J,PSSTIEN)) Q:PSSTIEN=""  D
    42         .S PSSIEN2=($P(^TMP("DILIST",$J,PSSTIEN,0),U,1))
    43         .D DIRREAD
    44         Q
    45         ;
    46 LOOPDIR ;LOOP FOR A DIRECT READ.  READS ALL IENs FOR ^PSDRUG(
    47         S PSSIEN2=0
    48         F  S PSSIEN2=$O(^PS(51.2,PSSIEN2)) Q:'PSSIEN2  D
    49         .D DIRALL
    50         Q
    51         ;
    52 DIRALL  ;TEST FOR PSSFL, PSSPK, BAILS IF CONDITIONS MEET TRUE
    53         I $G(PSSFL),$P($G(^PS(51.2,PSSIEN2,0)),U,5),$P($G(^PS(51.2,PSSIEN2,0)),U,5)'>PSSFL Q
    54         I $G(PSSPK)]"" N PSSZ5,PSSZ6 S PSSZ5=0 F PSSZ6=1:1:$L(PSSPK) Q:PSSZ5  I $P($G(^PS(51.2,PSSIEN2,0)),U,4)[$E(PSSPK,PSSZ6) S PSSZ5=1
    55         I $G(PSSPK)]"",'PSSZ5 Q
    56         D DIRREAD
    57         Q
    58         ;
    59 DIRREAD ;MAIN DIRECT READ FOR ENTIRE ROUTINE
    60         S PSSNAM=$P($G(^PS(51.2,PSSIEN2,0)),U,1)
    61         S ^TMP($J,LIST,PSSIEN2,.01)=PSSNAM
    62         S ^TMP($J,LIST,PSSIEN2,1)=$P($G(^PS(51.2,PSSIEN2,0)),U,3)
    63         S PSSTMP=$P($G(^PS(51.2,PSSIEN2,0)),U,4)
    64         I PSSTMP="0" S ^TMP($J,LIST,PSSIEN2,3)=PSSTMP_U_"NATIONAL DRUG FILE ONLY"
    65         I PSSTMP="1" S ^TMP($J,LIST,PSSIEN2,3)=PSSTMP_U_"ALL PACKAGES"
    66         I PSSTMP="" S ^TMP($J,LIST,PSSIEN2,3)=""
    67         S ^TMP($J,LIST,PSSIEN2,4)=$P($G(^PS(51.2,PSSIEN2,0)),U,2)
    68         S ^TMP($J,LIST,PSSIEN2,4.1)=$P($G(^PS(51.2,PSSIEN2,0)),U,7)
    69         I $P($G(^PS(51.2,PSSIEN2,0)),U,5)'="" D
    70         .S PSSCAP=$$UP^XLFSTR($$FMTE^XLFDT($P($G(^PS(51.2,PSSIEN2,0)),U,5)))
    71         .S ^TMP($J,LIST,PSSIEN2,5)=$P($G(^PS(51.2,PSSIEN2,0)),U,5)_U_PSSCAP
    72         ELSE  S ^TMP($J,LIST,PSSIEN2,5)=""
    73         N PSSTMP S PSSTMP=$P($G(^PS(51.2,PSSIEN2,0)),U,6)
    74         I PSSTMP="0"!PSSTMP="" S ^TMP($J,LIST,PSSIEN2,6)=PSSTMP_U_"NO"
    75         I PSSTMP="1" D
    76         .S ^TMP($J,LIST,PSSIEN2,6)=PSSTMP_U_"YES"
    77         .S ^TMP($J,LIST,"IV",PSSNAM,PSSIEN2)=""
    78         I PSSTMP="" S ^TMP($J,LIST,PSSIEN2,6)=""
    79         S ^TMP($J,LIST,"B",$P($G(^PS(51.2,PSSIEN2,0)),U,1),PSSIEN2)=""
    80         N PSSAB S PSSAB=$P($G(^PS(51.2,PSSIEN2,0)),U,3) I PSSAB]"" S ^TMP($J,LIST,"C",PSSAB,PSSIEN2)=""
    81         S PSSTMP=$P($G(^PS(51.2,PSSIEN2,0)),U,8)
    82         S ^TMP($J,LIST,PSSIEN2,7)=PSSTMP I PSSTMP]"" S ^(7)=^(7)_U_$S(PSSTMP:"YES",1:"NO")
    83         S PSSTMP=$P($G(^PS(51.2,PSSIEN2,0)),U,9)
    84         S ^TMP($J,LIST,PSSIEN2,8)=PSSTMP I PSSTMP]"" S ^(8)=^(8)_U_$S(PSSTMP:"YES",1:"NO")
    85         S PSSBGCNT=PSSBGCNT+1
    86         Q
    87         ;
    88 SETSCRN ;Set Screen for inactive Medication Routes
    89         ;Naked reference below refers to ^PS(51.2,+Y,0)
    90         S SCR("S")="S ND=$P($G(^(0)),U,5) I ND=""""!(ND>PSSFL)"
    91         Q
    92         ;
    93 NAME(PSSFT,PSSPK,LIST)  ;
    94         ;PSSFT - Free Text name in MEDICATION ROUTES file (#51.2).
    95         ;PSSPK - PACKAGE USE field (#3) of the MEDICATION ROUTES file (#51.2).
    96         ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is
    97         ;the Field Number of the data piece being returned.
    98         ;Returns NAME field (#.01), ABBREVIATION field (#1), and INACTIVATION DATE field (#5)
    99         ;of MEDICATION ROUTES file (#51.2).
    100         N DIERR,ZZERR,PSS51P2,SCR,PSS
    101         I $G(LIST)']"" Q
    102         K ^TMP($J,LIST)
    103         I ($G(PSSFT)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
    104         ;Naked reference below refers to ^PS(51.2,+Y,0)
    105         S SCR("S")=$S($G(PSSPK)]"":"I $P($G(^(0)),""^"",4)=$G(PSSPK)",1:"")
    106         I PSSFT["??" D LOOP(2) Q
    107         D FIND^DIC(51.2,,"@;.01;1","QP",PSSFT,,"B",SCR("S"),,"")
    108         I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
    109         S ^TMP($J,LIST,0)=+^TMP("DILIST",$J,0)
    110         N PSSXX S PSSXX=0 F  S PSSXX=$O(^TMP("DILIST",$J,PSSXX)) Q:'PSSXX  D
    111         .S PSSIEN=+^TMP("DILIST",$J,PSSXX,0) K ^TMP("PSS51P2",$J) D GETS^DIQ(51.2,+PSSIEN,".01;1;5","IE","^TMP(""PSS51P2"",$J)") S PSS(1)=0
    112         .F  S PSS(1)=$O(^TMP("PSS51P2",$J,51.2,PSS(1))) Q:'PSS(1)  D SETZRO2
    113         K TMP("DILIST",$J),^TMP("PSS51P2",$J)
    114         Q
    115         ;
    116 IEN(PSSABBR,LIST)       ;
    117         ;PSSABBR - ABBREVIATION field (#1) in MEDICATION ROUTES file (#51.2).
    118         ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is
    119         ;the Field Number of the data piece being returned.
    120         ;Returns NAME field (#.01), ABBREVIATION field (#1), and INACTIVATION DATE field (#5)
    121         ;of MEDICATION ROUTES file (#51.2).
    122         N DIERR,ZZERR,PSS51P2,SCR,PSS
    123         I $G(LIST)']"" Q
    124         K ^TMP($J,LIST)
    125         I ($G(PSSABBR)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
    126         D FIND^DIC(51.2,,"@;.01;1","QP",PSSABBR,,"C",,,"")
    127         I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
    128         S ^TMP($J,LIST,0)=+^TMP("DILIST",$J,0)
    129         N PSSXX S PSSXX=0 F  S PSSXX=$O(^TMP("DILIST",$J,PSSXX)) Q:'PSSXX  D
    130         .S PSSIEN=+^TMP("DILIST",$J,PSSXX,0) K ^TMP("PSS51P2",$J) D GETS^DIQ(51.2,+PSSIEN,".01;1;3;4;5;6;4.1","IE","^TMP(""PSS51P2"",$J)") S PSS(1)=0
    131         .F  S PSS(1)=$O(^TMP("PSS51P2",$J,51.2,PSS(1))) Q:'PSS(1)  D SETZRO2
    132         K TMP("DILIST",$J),^TMP("PSS51P2",$J)
    133         Q
    134         ;
    135 SETZRO  ;
    136         S ^TMP($J,LIST,+PSS(1),.01)=$G(^TMP("PSS51P2",$J,51.2,PSS(1),.01,"I"))
    137         S ^TMP($J,LIST,"B",$G(^TMP("PSS51P2",$J,51.2,PSS(1),.01,"I")),+PSS(1))=""
    138         S ^TMP($J,LIST,+PSS(1),4)=$G(^TMP("PSS51P2",$J,51.2,PSS(1),4,"I"))
    139         S ^TMP($J,LIST,+PSS(1),1)=$G(^TMP("PSS51P2",$J,51.2,PSS(1),1,"I"))
    140         S ^TMP($J,LIST,+PSS(1),3)=$S($G(^TMP("PSS51P2",$J,51.2,PSS(1),3,"I"))="":"",1:^TMP("PSS51P2",$J,51.2,PSS(1),3,"I")_"^"_^TMP("PSS51P2",$J,51.2,PSS(1),3,"E"))
    141         S ^TMP($J,LIST,+PSS(1),5)=$S($G(^TMP("PSS51P2",$J,51.2,PSS(1),5,"I"))="":"",1:^TMP("PSS51P2",$J,51.2,PSS(1),5,"I")_"^"_^TMP("PSS51P2",$J,51.2,PSS(1),5,"E"))
    142         S ^TMP($J,LIST,+PSS(1),6)=$S($G(^TMP("PSS51P2",$J,51.2,PSS(1),6,"I"))="":"",1:^TMP("PSS51P2",$J,51.2,PSS(1),6,"I")_"^"_^TMP("PSS51P2",$J,51.2,PSS(1),6,"E"))
    143         S ^TMP($J,LIST,+PSS(1),4.1)=$G(^TMP("PSS51P2",$J,51.2,PSS(1),4.1,"I"))
    144         Q
    145         ;
    146 SETZRO2 ;
    147         S ^TMP($J,LIST,+PSS(1),.01)=$G(^TMP("PSS51P2",$J,51.2,PSS(1),.01,"I"))
    148         S ^TMP($J,LIST,"B",$G(^TMP("PSS51P2",$J,51.2,PSS(1),.01,"I")),+PSS(1))=""
    149         S ^TMP($J,LIST,+PSS(1),1)=$G(^TMP("PSS51P2",$J,51.2,PSS(1),1,"I"))
    150         S ^TMP($J,LIST,+PSS(1),5)=$S($G(^TMP("PSS51P2",$J,51.2,PSS(1),5,"I"))="":"",1:^TMP("PSS51P2",$J,51.2,PSS(1),5,"I")_"^"_^TMP("PSS51P2",$J,51.2,PSS(1),5,"E"))
    151         Q
    152         ;
    153 LOOP(PSS)       ;
    154         N CNT S CNT=0
    155         S PSSIEN=0 F  S PSSIEN=$O(^PS(51.2,PSSIEN)) Q:'PSSIEN  D @(PSS)
    156         S ^TMP($J,LIST,0)=$S($G(CNT)>0:CNT,1:"-1^NO DATA FOUND")
    157         Q
    158         ;
    159 1       ;
    160         S ND=$G(^PS(51.2,+PSSIEN,0))
    161         I +$G(PSSFL)>0 Q:$P($G(ND),"^",5)]""&($P($G(ND),"^",5)'>$G(PSSFL))
    162         I $G(PSSPK)]"" Q:$P($G(ND),"^",4)'=$G(PSSPK)
    163         K ^TMP("PSS51P2",$J) D GETS^DIQ(51.2,+PSSIEN,".01;1;3;4;5;6;4.1","IE","^TMP(""PSS51P2"",$J)") S PSS(1)=0 D
    164         .F  S PSS(1)=$O(^TMP("PSS51P2",$J,51.2,PSS(1))) Q:'PSS(1)  D SETZRO S CNT=CNT+1
    165         Q
    166         ;
    167 2       ;
    168         I $G(PSSPK)]"",$P($G(^PS(51.2,+PSSIEN,0)),"^",4)'=$G(PSSPK) Q
    169         K ^TMP("PSS51P2",$J) D GETS^DIQ(51.2,+PSSIEN,".01;1;5","IE","^TMP(""PSS51P2"",$J)") S PSS(1)=0 D
    170         .F  S PSS(1)=$O(^TMP("PSS51P2",$J,51.2,PSS(1))) Q:'PSS(1)  D SETZRO2 S CNT=CNT+1
    171         Q
     1PSS51P2 ;BIR/LDT - API FOR INFORMATION FROM FILE 51.2 ; 5 Sep 03
     2 ;;1.0;PHARMACY DATA MANAGEMENT;**85,112,118,88**;9/30/97;Build 12
     3 ;
     4ALL(PSSIEN,PSSFT,PSSFL,PSSPK,LIST) ;
     5 ;PSSIEN - IEN of entry in MEDICATION ROUTES file (#51.2).
     6 ;PSSFT - Free Text name in MEDICATION ROUTES file (#51.2).
     7 ;PSSFL - Inactive flag - "" - All entries
     8 ;        FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
     9 ;PSSPK - PACKAGE USE field (#3) of the MEDICATION ROUTES file (#51.2).
     10 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is
     11 ;the Field Number of the data piece being returned.
     12 ;Returns NAME field (#.01), ABBREVIATION field (#1), PACKAGE USE field (#3), OUTPATIENT EXPANSION field (#4),
     13 ;OTHER LANGUAGE EXPANSION field (#4.1), INACTIVATION DATE field (#5), and IV FLAG field (#6)
     14 ;of MEDICATION ROUTES file (#51.2).
     15 N DIERR,ZZERR,PSS51P2,SCR,PSS,PSSBGCNT,PSSCNT,PSSTIEN,PSSTMP,PSSNAM,PSSCAP
     16 S PSSBGCNT=0
     17 S SCR("S")=""
     18 I $G(LIST)']"" Q
     19 K ^TMP("DILIST",$J)
     20 K ^TMP($J,LIST)
     21 I +$G(PSSIEN)'>0,($G(PSSFT)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
     22 S SCR("S")=""
     23 I +$G(PSSFL)>0 N ND D SETSCRN
     24 ;Naked reference below refers to ^PS(51.2,+Y,0)
     25 I $G(PSSPK)]"" S SCR("S")=$S(SCR("S")]"":SCR("S")_" I $P($G(^(0)),U,4)=$G(PSSPK)",1:"I $P($G(^(0)),U,4)=$G(PSSPK)")
     26 I +$G(PSSIEN)>0 N PSSIEN2 S PSSIEN2=$$FIND1^DIC(51.2,"","A","`"_PSSIEN,,SCR("S"),"") D  D COUNTBG Q
     27 .I PSSIEN2>0 D DIRREAD
     28 I +$G(PSSIEN)=0 D
     29 .I PSSFT="??" D LOOPDIR D COUNTBG Q
     30 .D FIND^DIC(51.2,,"@;.01;1","QP",PSSFT,,"B",SCR("S"),,"") D LOOPDI D COUNTBG
     31 Q
     32 ;
     33COUNTBG ;CHECKS PSSBGCNT AND FILLS COUNT IN ON 0 NODE OF ^TMP($J,LIST)
     34 I PSSBGCNT>0 D
     35 .S ^TMP($J,LIST,0)=PSSBGCNT
     36 ELSE  S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND"
     37 Q
     38 ;
     39LOOPDI ;LOOPS ON "DILIST" FROM FILEMAN CALL (USED FOR RETURNING MULTIPLE DRUGS FROM PSSFT)
     40 S PSSTIEN=0 ;TEMP IEN TO ITERATE OVER DILIST
     41 F  S PSSTIEN=$O(^TMP("DILIST",$J,PSSTIEN)) Q:PSSTIEN=""  D
     42 .S PSSIEN2=($P(^TMP("DILIST",$J,PSSTIEN,0),U,1))
     43 .D DIRREAD
     44 Q
     45 ;
     46LOOPDIR ;LOOP FOR A DIRECT READ.  READS ALL IENs FOR ^PSDRUG(
     47 S PSSIEN2=0
     48 F  S PSSIEN2=$O(^PS(51.2,PSSIEN2)) Q:'PSSIEN2  D
     49 .D DIRALL
     50 Q
     51 ;
     52DIRALL ;TEST FOR PSSFL, PSSPK, BAILS IF CONDITIONS MEET TRUE
     53 I $G(PSSFL),$P($G(^PS(51.2,PSSIEN2,0)),U,5),$P($G(^PS(51.2,PSSIEN2,0)),U,5)'>PSSFL Q
     54 I $G(PSSPK)]"" N PSSZ5,PSSZ6 S PSSZ5=0 F PSSZ6=1:1:$L(PSSPK) Q:PSSZ5  I $P($G(^PS(51.2,PSSIEN2,0)),U,4)[$E(PSSPK,PSSZ6) S PSSZ5=1
     55 I $G(PSSPK)]"",'PSSZ5 Q
     56 D DIRREAD
     57 Q
     58 ;
     59DIRREAD ;MAIN DIRECT READ FOR ENTIRE ROUTINE
     60 S PSSNAM=$P($G(^PS(51.2,PSSIEN2,0)),U,1)
     61 S ^TMP($J,LIST,PSSIEN2,.01)=PSSNAM
     62 S ^TMP($J,LIST,PSSIEN2,1)=$P($G(^PS(51.2,PSSIEN2,0)),U,3)
     63 S PSSTMP=$P($G(^PS(51.2,PSSIEN2,0)),U,4)
     64 I PSSTMP="0" S ^TMP($J,LIST,PSSIEN2,3)=PSSTMP_U_"NATIONAL DRUG FILE ONLY"
     65 I PSSTMP="1" S ^TMP($J,LIST,PSSIEN2,3)=PSSTMP_U_"ALL PACKAGES"
     66 I PSSTMP="" S ^TMP($J,LIST,PSSIEN2,3)=""
     67 S ^TMP($J,LIST,PSSIEN2,4)=$P($G(^PS(51.2,PSSIEN2,0)),U,2)
     68 S ^TMP($J,LIST,PSSIEN2,4.1)=$P($G(^PS(51.2,PSSIEN2,0)),U,7)
     69 I $P($G(^PS(51.2,PSSIEN2,0)),U,5)'="" D
     70 .S PSSCAP=$$UP^XLFSTR($$FMTE^XLFDT($P($G(^PS(51.2,PSSIEN2,0)),U,5)))
     71 .S ^TMP($J,LIST,PSSIEN2,5)=$P($G(^PS(51.2,PSSIEN2,0)),U,5)_U_PSSCAP
     72 ELSE  S ^TMP($J,LIST,PSSIEN2,5)=""
     73 N PSSTMP S PSSTMP=$P($G(^PS(51.2,PSSIEN2,0)),U,6)
     74 I PSSTMP="0"!PSSTMP="" S ^TMP($J,LIST,PSSIEN2,6)=PSSTMP_U_"NO"
     75 I PSSTMP="1" D
     76 .S ^TMP($J,LIST,PSSIEN2,6)=PSSTMP_U_"YES"
     77 .S ^TMP($J,LIST,"IV",PSSNAM,PSSIEN2)=""
     78 I PSSTMP="" S ^TMP($J,LIST,PSSIEN2,6)=""
     79 S ^TMP($J,LIST,"B",$P($G(^PS(51.2,PSSIEN2,0)),U,1),PSSIEN2)=""
     80 S PSSTMP=$P($G(^PS(51.2,PSSIEN2,0)),U,8)
     81 S ^TMP($J,LIST,PSSIEN2,7)=PSSTMP I PSSTMP]"" S ^(7)=^(7)_U_$S(PSSTMP:"YES",1:"NO")
     82 S PSSTMP=$P($G(^PS(51.2,PSSIEN2,0)),U,9)
     83 S ^TMP($J,LIST,PSSIEN2,8)=PSSTMP I PSSTMP]"" S ^(8)=^(8)_U_$S(PSSTMP:"YES",1:"NO")
     84 S PSSBGCNT=PSSBGCNT+1
     85 Q
     86 ;
     87SETSCRN ;Set Screen for inactive Medication Routes
     88 ;Naked reference below refers to ^PS(51.2,+Y,0)
     89 S SCR("S")="S ND=$P($G(^(0)),U,5) I ND=""""!(ND>PSSFL)"
     90 Q
     91 ;
     92NAME(PSSFT,PSSPK,LIST) ;
     93 ;PSSFT - Free Text name in MEDICATION ROUTES file (#51.2).
     94 ;PSSPK - PACKAGE USE field (#3) of the MEDICATION ROUTES file (#51.2).
     95 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is
     96 ;the Field Number of the data piece being returned.
     97 ;Returns NAME field (#.01), ABBREVIATION field (#1), and INACTIVATION DATE field (#5)
     98 ;of MEDICATION ROUTES file (#51.2).
     99 N DIERR,ZZERR,PSS51P2,SCR,PSS
     100 I $G(LIST)']"" Q
     101 K ^TMP($J,LIST)
     102 I ($G(PSSFT)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
     103 ;Naked reference below refers to ^PS(51.2,+Y,0)
     104 S SCR("S")=$S($G(PSSPK)]"":"I $P($G(^(0)),""^"",4)=$G(PSSPK)",1:"")
     105 I PSSFT["??" D LOOP(2) Q
     106 D FIND^DIC(51.2,,"@;.01;1","QP",PSSFT,,"B",SCR("S"),,"")
     107 I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
     108 S ^TMP($J,LIST,0)=+^TMP("DILIST",$J,0)
     109 N PSSXX S PSSXX=0 F  S PSSXX=$O(^TMP("DILIST",$J,PSSXX)) Q:'PSSXX  D
     110 .S PSSIEN=+^TMP("DILIST",$J,PSSXX,0) K ^TMP("PSS51P2",$J) D GETS^DIQ(51.2,+PSSIEN,".01;1;5","IE","^TMP(""PSS51P2"",$J)") S PSS(1)=0
     111 .F  S PSS(1)=$O(^TMP("PSS51P2",$J,51.2,PSS(1))) Q:'PSS(1)  D SETZRO2
     112 K TMP("DILIST",$J),^TMP("PSS51P2",$J)
     113 Q
     114 ;
     115IEN(PSSABBR,LIST) ;
     116 ;PSSABBR - ABBREVIATION field (#1) in MEDICATION ROUTES file (#51.2).
     117 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is
     118 ;the Field Number of the data piece being returned.
     119 ;Returns NAME field (#.01), ABBREVIATION field (#1), and INACTIVATION DATE field (#5)
     120 ;of MEDICATION ROUTES file (#51.2).
     121 N DIERR,ZZERR,PSS51P2,SCR,PSS
     122 I $G(LIST)']"" Q
     123 K ^TMP($J,LIST)
     124 I ($G(PSSABBR)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
     125 D FIND^DIC(51.2,,"@;.01;1","QP",PSSABBR,,"C",,,"")
     126 I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
     127 S ^TMP($J,LIST,0)=+^TMP("DILIST",$J,0)
     128 N PSSXX S PSSXX=0 F  S PSSXX=$O(^TMP("DILIST",$J,PSSXX)) Q:'PSSXX  D
     129 .S PSSIEN=+^TMP("DILIST",$J,PSSXX,0) K ^TMP("PSS51P2",$J) D GETS^DIQ(51.2,+PSSIEN,".01;1;3;4;5;6;4.1","IE","^TMP(""PSS51P2"",$J)") S PSS(1)=0
     130 .F  S PSS(1)=$O(^TMP("PSS51P2",$J,51.2,PSS(1))) Q:'PSS(1)  D SETZRO2
     131 K TMP("DILIST",$J),^TMP("PSS51P2",$J)
     132 Q
     133 ;
     134SETZRO ;
     135 S ^TMP($J,LIST,+PSS(1),.01)=$G(^TMP("PSS51P2",$J,51.2,PSS(1),.01,"I"))
     136 S ^TMP($J,LIST,"B",$G(^TMP("PSS51P2",$J,51.2,PSS(1),.01,"I")),+PSS(1))=""
     137 S ^TMP($J,LIST,+PSS(1),4)=$G(^TMP("PSS51P2",$J,51.2,PSS(1),4,"I"))
     138 S ^TMP($J,LIST,+PSS(1),1)=$G(^TMP("PSS51P2",$J,51.2,PSS(1),1,"I"))
     139 S ^TMP($J,LIST,+PSS(1),3)=$S($G(^TMP("PSS51P2",$J,51.2,PSS(1),3,"I"))="":"",1:^TMP("PSS51P2",$J,51.2,PSS(1),3,"I")_"^"_^TMP("PSS51P2",$J,51.2,PSS(1),3,"E"))
     140 S ^TMP($J,LIST,+PSS(1),5)=$S($G(^TMP("PSS51P2",$J,51.2,PSS(1),5,"I"))="":"",1:^TMP("PSS51P2",$J,51.2,PSS(1),5,"I")_"^"_^TMP("PSS51P2",$J,51.2,PSS(1),5,"E"))
     141 S ^TMP($J,LIST,+PSS(1),6)=$S($G(^TMP("PSS51P2",$J,51.2,PSS(1),6,"I"))="":"",1:^TMP("PSS51P2",$J,51.2,PSS(1),6,"I")_"^"_^TMP("PSS51P2",$J,51.2,PSS(1),6,"E"))
     142 S ^TMP($J,LIST,+PSS(1),4.1)=$G(^TMP("PSS51P2",$J,51.2,PSS(1),4.1,"I"))
     143 Q
     144 ;
     145SETZRO2 ;
     146 S ^TMP($J,LIST,+PSS(1),.01)=$G(^TMP("PSS51P2",$J,51.2,PSS(1),.01,"I"))
     147 S ^TMP($J,LIST,"B",$G(^TMP("PSS51P2",$J,51.2,PSS(1),.01,"I")),+PSS(1))=""
     148 S ^TMP($J,LIST,+PSS(1),1)=$G(^TMP("PSS51P2",$J,51.2,PSS(1),1,"I"))
     149 S ^TMP($J,LIST,+PSS(1),5)=$S($G(^TMP("PSS51P2",$J,51.2,PSS(1),5,"I"))="":"",1:^TMP("PSS51P2",$J,51.2,PSS(1),5,"I")_"^"_^TMP("PSS51P2",$J,51.2,PSS(1),5,"E"))
     150 Q
     151 ;
     152LOOP(PSS) ;
     153 N CNT S CNT=0
     154 S PSSIEN=0 F  S PSSIEN=$O(^PS(51.2,PSSIEN)) Q:'PSSIEN  D @(PSS)
     155 S ^TMP($J,LIST,0)=$S($G(CNT)>0:CNT,1:"-1^NO DATA FOUND")
     156 Q
     157 ;
     1581 ;
     159 S ND=$G(^PS(51.2,+PSSIEN,0))
     160 I +$G(PSSFL)>0 Q:$P($G(ND),"^",5)]""&($P($G(ND),"^",5)'>$G(PSSFL))
     161 I $G(PSSPK)]"" Q:$P($G(ND),"^",4)'=$G(PSSPK)
     162 K ^TMP("PSS51P2",$J) D GETS^DIQ(51.2,+PSSIEN,".01;1;3;4;5;6;4.1","IE","^TMP(""PSS51P2"",$J)") S PSS(1)=0 D
     163 .F  S PSS(1)=$O(^TMP("PSS51P2",$J,51.2,PSS(1))) Q:'PSS(1)  D SETZRO S CNT=CNT+1
     164 Q
     165 ;
     1662 ;
     167 I $G(PSSPK)]"",$P($G(^PS(51.2,+PSSIEN,0)),"^",4)'=$G(PSSPK) Q
     168 K ^TMP("PSS51P2",$J) D GETS^DIQ(51.2,+PSSIEN,".01;1;5","IE","^TMP(""PSS51P2"",$J)") S PSS(1)=0 D
     169 .F  S PSS(1)=$O(^TMP("PSS51P2",$J,51.2,PSS(1))) Q:'PSS(1)  D SETZRO2 S CNT=CNT+1
     170 Q
Note: See TracChangeset for help on using the changeset viewer.