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/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORMFN.m

    r613 r623  
    1 ORMFN   ; SLC/MKB - MFN msg router ;11/21/2006
    2         ;;3.0;ORDER ENTRY/RESULTS REPORTING;**26,97,94,176,215,243**;Dec 17, 1997;Build 242
    3 EN(MSG) ; -- main entry point for OR ITEM RECEIVE
    4         N ORMSG,ORNMSP,ORDG,MSH,MFI,MFE,ZPKG,ZSY,NTE,ORMFE,ORDITEM,ORACTION,ORDIFN,ORFIEN,ORFLD,ORFDA,NUM,VALUE,X,Y,DA,DIC,DIK,SYS,ZLC,LAST,NAME,ID,INACTIVE,I,ORY,NEXT,DD,DO
    5         S ORMSG=$G(MSG,"MSG") Q:'$O(@ORMSG@(0))  ; msg array root
    6         N ORNOW S ORNOW=$$NOW^XLFDT ;M ^XTMP("OR ITEM RECEIVE",ORNOW)=@ORMSG
    7 MSH     S MSH=0 F  S MSH=$O(@ORMSG@(MSH)) Q:MSH'>0  Q:$E(@ORMSG@(MSH),1,3)="MSH"
    8         Q:'MSH  S MSH=MSH_U_@ORMSG@(MSH)
    9         S X=$P(MSH,"|",3) S:X="RADIOLOGY" X="IMAGING"
    10         S ORDG=$O(^ORD(100.98,"B",X,0)),ORNMSP=$$NMSP(X) Q:'$L(ORNMSP)
    11         S MFI=$O(@ORMSG@(+MSH)) Q:$E(@ORMSG@(MFI),1,3)'="MFI"  ; error
    12 MFE     S MFE=+MFI ; ** loop through each MFE segment
    13         F  S MFE=$O(@ORMSG@(+MFE)) Q:MFE'>0  I $E(@ORMSG@(MFE),1,3)="MFE" D
    14         . K ORFLD,ORFDA
    15         . S MFE=MFE_U_@ORMSG@(MFE),ORMFE=$P(MFE,"|",2),INACTIVE=$P(MFE,"|",4)
    16         . S ORDITEM=$P(MFE,"|",5),NAME=$TR($P(ORDITEM,U,5),"~"," ")
    17         . S ID=$P(ORDITEM,U,4)_";"_$P(ORDITEM,U,6)
    18         . S ORDIFN=+$O(^ORD(101.43,"ID",ID,0)),ORFIEN=ORDIFN_","
    19         . S ORACTION=$S(ORMFE="MAD":1,(ORMFE="MAC")&('ORDIFN):1,(ORMFE="MUP")&('ORDIFN):1,'ORDIFN:0,ORMFE="MAC":2,ORMFE="MUP":2,ORMFE="MDC":3,ORMFE="MDL":3,1:0) ; 1=add, 2=change, 3=delete (inactivate)
    20         . Q:'ORACTION  ; 0=error
    21         . I ORACTION=3 S ORFDA(101.43,ORFIEN,.1)=$S(INACTIVE:$$HL7TFM^XLFDT(INACTIVE),1:$$NOW^XLFDT) D FILE^DIE("K","ORFDA") Q
    22 ADD     . I ORACTION=1,'ORDIFN D  Q:'ORDIFN  ;create item if it doesn't exist
    23         . . S ORDIFN=$$CREATE(NAME),ORFIEN=ORDIFN_","
    24         . . S ORFDA(101.43,ORFIEN,5)=+ORDG
    25         . S ORFLD(.01)=NAME,ORFLD(1.1)=NAME,ORFLD(2)=ID,ORFLD(3)=$P(ORDITEM,U)
    26         . S SYS=$P(ORDITEM,U,3),ORFLD(4)=$S(+SYS=99:$E(SYS,3,99),1:SYS)
    27         . S ORFLD(.1)=$S(ORMFE="MAC":"@",(ORMFE="MUP")&('INACTIVE):"@",INACTIVE:$$HL7TFM^XLFDT(INACTIVE),1:"")
    28         . F NUM=.01,.1,1.1,2,3,4 S VALUE=$S(ORFLD(NUM)="":"@",1:ORFLD(NUM)) D VAL^DIE(101.43,ORFIEN,NUM,"F",VALUE,.ORY,"ORFDA")
    29 ZPKG    . S LAST=+MFE,ZPKG=$O(@ORMSG@(+MFE))
    30         . I ZPKG,$E(@ORMSG@(ZPKG),1,3)=("Z"_ORNMSP) S ZPKG=ZPKG_U_@ORMSG@(ZPKG),LAST=+ZPKG D @ORNMSP ; ZXX segment
    31         . D FILE^DIE("K","ORFDA") ; file data
    32 ZLC     . S NEXT=$O(@ORMSG@(LAST)) I NEXT,$E(@ORMSG@(NEXT),1,3)="ZLC" D
    33         . . N COMP,CID,CODE,CSYS
    34         . . K DA,^ORD(101.43,ORDIFN,10) ;S DIC("P")=$P(^DD(101.43,10,0),U,2)
    35         . . S DA(1)=ORDIFN,DIC="^ORD(101.43,"_DA(1)_",10,",DIC(0)="L",ZLC=LAST
    36         . . F  S ZLC=$O(@ORMSG@(ZLC)) Q:ZLC'>0  Q:$E(@ORMSG@(ZLC),1,3)'="ZLC"  D
    37         . . . S COMP=$P(@ORMSG@(ZLC),"|",5),X=$P(COMP,U,5) I X="" S LAST=ZLC Q
    38         . . . S CID=$P(COMP,U,4)_";"_$P(COMP,U,6) K DIC("DR"),DO,DD
    39         . . . S CODE=$P(COMP,U),CSYS=$P(COMP,U,3) S:+CSYS=99 CSYS=$E(CSYS,3,99)
    40         . . . S DIC("DR")="2///^S X=CID;3///^S X=CODE;4///^S X=CSYS"
    41         . . . D FILE^DICN S LAST=ZLC
    42 ZSY     . I $D(^ORD(101.43,ORDIFN,2)) D  ; kill old ones first
    43         . . S DA(1)=ORDIFN,DIK="^ORD(101.43,"_DA(1)_",2,"
    44         . . S DA=0 F  S DA=$O(^ORD(101.43,DA(1),2,DA)) Q:DA'>0  D ^DIK
    45         . . K ^ORD(101.43,ORDIFN,2),DIK,DA
    46         . S NEXT=$O(@ORMSG@(LAST)) I NEXT,$E(@ORMSG@(NEXT),1,3)="ZSY" D
    47         . . K DA,DIC S DA(1)=ORDIFN,DIC="^ORD(101.43,"_DA(1)_",2,"
    48         . . S DIC(0)="L",ZSY=LAST ;,DIC("P")=$P(^DD(101.43,1,0),U,2)
    49         . . F  S ZSY=$O(@ORMSG@(+ZSY)) Q:ZSY'>0  Q:$E(@ORMSG@(ZSY),1,3)'="ZSY"  D
    50         . . . S X=$P(@ORMSG@(ZSY),"|",3),LAST=ZSY
    51         . . . K DD,DO D:$L(X) FILE^DICN
    52 NTE     . K ^ORD(101.43,ORDIFN,8) ; replace text
    53         . S NEXT=$O(@ORMSG@(LAST)) I NEXT,$E(@ORMSG@(NEXT),1,3)="NTE" D
    54         . . S NTE=LAST,DA=0
    55         . . F  S NTE=$O(@ORMSG@(NTE)) Q:NTE'>0  Q:$E(@ORMSG@(NTE),1,3)'="NTE"  S DA=DA+1,^ORD(101.43,ORDIFN,8,DA,0)=$P(@ORMSG@(NTE),"|",4) I $O(@ORMSG@(NTE,0)) D
    56         . . . S I=0 F  S I=$O(@ORMSG@(NTE,I)) Q:I'>0  S DA=DA+1,^ORD(101.43,ORDIFN,8,DA,0)=@ORMSG@(NTE,I)
    57         . . S ^ORD(101.43,ORDIFN,8,0)="^^"_DA_U_DA_U_DT_U
    58         Q
    59         ;
    60 NMSP(NAME)      ; -- returns namespace for package
    61         I NAME="RADIOLOGY" Q "RA"
    62         I NAME="IMAGING" Q "RA"
    63         I NAME="LABORATORY" Q "LR"
    64         I NAME="DIETETICS" Q "FH"
    65         I NAME="PHARMACY" Q "PS"
    66         I NAME="CONSULTS" Q "CS"
    67         I NAME="PROCEDURES" Q "CS"
    68         Q ""
    69         ;
    70 CREATE(X)       ; -- Create new item in #101.43
    71         Q:'$L($G(X)) 0 N HDR,LAST,TOTAL,I
    72         L +^ORD(101.43,0):1 Q:'$T 0
    73         S HDR=$G(^ORD(101.43,0)) Q:HDR="" 0
    74         S LAST=$P(HDR,U,3),TOTAL=$P(HDR,U,4)
    75         F I=(LAST+1):1 Q:'$D(^ORD(101.43,I,0))
    76         S ^ORD(101.43,I,0)=X,X=$E(X,1,30),^ORD(101.43,"B",$$UP^XLFSTR(X),I)=""
    77         S $P(^ORD(101.43,0),U,3,4)=I_U_(TOTAL+1)
    78         L -^ORD(101.43,0)
    79         Q I
    80         ;
    81 FH      ; -- Dietetics
    82         S X=$P(ZPKG,"|",2),ORFLD(111.1)=$S(X="":"@",1:X)
    83         S X=$P(ZPKG,"|",3),ORFLD(111.2)=$S(X="":"@",1:X)
    84         S X=$P(ZPKG,"|",5),ORFLD(111.3)=$S(X="":"@",1:X)
    85         F NUM=111.1,111.2,111.3 D VAL^DIE(101.43,ORFIEN,NUM,"F",ORFLD(NUM),.ORY,"ORFDA")
    86         K ^ORD(101.43,ORDIFN,8) S X=$P(ZPKG,"|",4)
    87         I $L(X) S ^ORD(101.43,ORDIFN,8,0)="^^1^1^"_DT_U,^(1,0)=X
    88         Q
    89         ;
    90 LR      ; -- Laboratory
    91         S X=$P(ZPKG,"|",2),ORFLD(60.1)=$S(X="":"@",1:X)
    92         S X=$P(ZPKG,"|",3),ORFLD(60.2)=$S(X="":"@",1:X)
    93         ;S X=$P(ZPKG,"|",4),ORFLD(60.3)=$S(X="":"@",1:X)
    94         S X=$P(ZPKG,"|",5),ORFLD(60.6)=$S(X="":"@",1:X)
    95         S X=$P(ZPKG,"|",6),ORFLD(60.4)=$S(X="":"@",1:X)
    96         S X=$P(ZPKG,"|",7),ORFLD(60.5)=$S(X="":"@",1:X)
    97         S X=$P(ZPKG,"|",8),ORFLD(6)=$S(X="":"@",1:X)
    98         S X=$P(ZPKG,"|",9),ORFLD(60.7)=$S(X="":"@",1:X)
    99         F NUM=6,60.1,60.2,60.4,60.5,60.6,60.7 D VAL^DIE(101.43,ORFIEN,NUM,"F",ORFLD(NUM),.ORY,"ORFDA")
    100         Q
    101         ;
    102 PS      ; -- Pharmacy
    103         N ROUTE
    104         S X=$P(ZPKG,"|",2)
    105         ;S ORFDA(101.43,ORFIEN,50.1)=$S(X'["I":0,$L($P($P(ORDITEM,U,5),"~",3)):2,1:1)
    106         S ORFDA(101.43,ORFIEN,50.1)=$S(X["V":2,X["I":1,1:0) ;inpt or iv med
    107         S ORFDA(101.43,ORFIEN,50.2)=(X["O") ;outpt med
    108         S ORFDA(101.43,ORFIEN,50.3)=(X["B") ;fluid base/soln
    109         S ORFDA(101.43,ORFIEN,50.4)=(X["A") ;fluid additive
    110         S ORFDA(101.43,ORFIEN,50.5)=(X["S") ;supply item
    111         S ORFDA(101.43,ORFIEN,50.7)=(X["N") ;non-VA med
    112         S X=$P(ZPKG,"|",3),ORFDA(101.43,ORFIEN,50.6)=$S(X:1,1:0)
    113         ;Check for default med route
    114         ;S ROUTE=$$MEDROUTE
    115         ;I ROUTE>0 S ORFDA(101.43,ORFIEN,50.8)=ROUTE
    116         Q
    117         ;
    118 MEDROUTE()      ;
    119         N CNT,ROUTE
    120         S CNT=0,ROUTE=0
    121         F  S CNT=$O(@ORMSG@(CNT)) Q:CNT'>0  D
    122         .I $P($G(@ORMSG@(CNT)),"|")'="ZPB" Q
    123         .S ROUTE=+$P($G(@ORMSG@(CNT)),"|",4)
    124         Q ROUTE
    125         ;
    126 RA      ; -- Radiology/Nuc Medicine
    127         S X=$P(ZPKG,"|",4),ORFLD(6)=$S(X="":"@",1:X)
    128         S X=$P(ZPKG,"|",5),ORFLD(71.1)=$S(X="":"@",1:X)
    129         S X=$P(ZPKG,"|",7),ORFLD(71.2)=$S(X="":"@",1:X)
    130         S X=$P(ZPKG,"|",2),ORFLD(71.3)=$S(X="":"@",1:X)
    131         S ORFLD(71.4)=$S($P(ZPKG,"|",6)="Y":1,1:0)
    132         S ORFLD(7)=$S($P(ZPKG,"|",3)="Y":2,1:1)
    133         F NUM=6,7,71.1,71.2,71.3,71.4 D VAL^DIE(101.43,ORFIEN,NUM,"F",ORFLD(NUM),.ORY,"ORFDA")
    134         Q
    135         ;
    136 CS      ; -- Consults/Requests
    137         S X=$P(ZPKG,"|",2),ORFLD(123.1)=$S(X="":"@",1:X)
    138         D VAL^DIE(101.43,ORFIEN,123.1,"F",ORFLD(123.1),.ORY,"ORFDA")
    139         Q
     1ORMFN ; SLC/MKB - MFN msg router ;04:29 PM  19 Dec 2000
     2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**26,97,94,176,215**;Dec 17, 1997
     3EN(MSG) ; -- main entry point for OR ITEM RECEIVE
     4 N ORMSG,ORNMSP,ORDG,MSH,MFI,MFE,ZPKG,ZSY,NTE,ORMFE,ORDITEM,ORACTION,ORDIFN,ORFIEN,ORFLD,ORFDA,NUM,VALUE,X,Y,DA,DIC,DIK,SYS,ZLC,LAST,NAME,ID,INACTIVE,I,ORY,NEXT,DD,DO
     5 S ORMSG=$G(MSG,"MSG") Q:'$O(@ORMSG@(0))  ; msg array root
     6 N ORNOW S ORNOW=$$NOW^XLFDT ;M ^XTMP("OR ITEM RECEIVE",ORNOW)=@ORMSG
     7MSH S MSH=0 F  S MSH=$O(@ORMSG@(MSH)) Q:MSH'>0  Q:$E(@ORMSG@(MSH),1,3)="MSH"
     8 Q:'MSH  S MSH=MSH_U_@ORMSG@(MSH)
     9 S X=$P(MSH,"|",3) S:X="RADIOLOGY" X="IMAGING"
     10 S ORDG=$O(^ORD(100.98,"B",X,0)),ORNMSP=$$NMSP(X) Q:'$L(ORNMSP)
     11 S MFI=$O(@ORMSG@(+MSH)) Q:$E(@ORMSG@(MFI),1,3)'="MFI"  ; error
     12MFE S MFE=+MFI ; ** loop through each MFE segment
     13 F  S MFE=$O(@ORMSG@(+MFE)) Q:MFE'>0  I $E(@ORMSG@(MFE),1,3)="MFE" D
     14 . K ORFLD,ORFDA
     15 . S MFE=MFE_U_@ORMSG@(MFE),ORMFE=$P(MFE,"|",2),INACTIVE=$P(MFE,"|",4)
     16 . S ORDITEM=$P(MFE,"|",5),NAME=$TR($P(ORDITEM,U,5),"~"," ")
     17 . S ID=$P(ORDITEM,U,4)_";"_$P(ORDITEM,U,6)
     18 . S ORDIFN=+$O(^ORD(101.43,"ID",ID,0)),ORFIEN=ORDIFN_","
     19 . S ORACTION=$S(ORMFE="MAD":1,(ORMFE="MAC")&('ORDIFN):1,(ORMFE="MUP")&('ORDIFN):1,'ORDIFN:0,ORMFE="MAC":2,ORMFE="MUP":2,ORMFE="MDC":3,ORMFE="MDL":3,1:0) ; 1=add, 2=change, 3=delete (inactivate)
     20 . Q:'ORACTION  ; 0=error
     21 . I ORACTION=3 S ORFDA(101.43,ORFIEN,.1)=$S(INACTIVE:$$HL7TFM^XLFDT(INACTIVE),1:$$NOW^XLFDT) D FILE^DIE("K","ORFDA") Q
     22ADD . I ORACTION=1,'ORDIFN D  Q:'ORDIFN  ;create item if it doesn't exist
     23 . . S ORDIFN=$$CREATE(NAME),ORFIEN=ORDIFN_","
     24 . . S ORFDA(101.43,ORFIEN,5)=+ORDG
     25 . S ORFLD(.01)=NAME,ORFLD(1.1)=NAME,ORFLD(2)=ID,ORFLD(3)=$P(ORDITEM,U)
     26 . S SYS=$P(ORDITEM,U,3),ORFLD(4)=$S(+SYS=99:$E(SYS,3,99),1:SYS)
     27 . S ORFLD(.1)=$S(ORMFE="MAC":"@",(ORMFE="MUP")&('INACTIVE):"@",INACTIVE:$$HL7TFM^XLFDT(INACTIVE),1:"")
     28 . F NUM=.01,.1,1.1,2,3,4 S VALUE=$S(ORFLD(NUM)="":"@",1:ORFLD(NUM)) D VAL^DIE(101.43,ORFIEN,NUM,"F",VALUE,.ORY,"ORFDA")
     29ZPKG . S LAST=+MFE,ZPKG=$O(@ORMSG@(+MFE))
     30 . I ZPKG,$E(@ORMSG@(ZPKG),1,3)=("Z"_ORNMSP) S ZPKG=ZPKG_U_@ORMSG@(ZPKG),LAST=+ZPKG D @ORNMSP ; ZXX segment
     31 . D FILE^DIE("K","ORFDA") ; file data
     32ZLC . S NEXT=$O(@ORMSG@(LAST)) I NEXT,$E(@ORMSG@(NEXT),1,3)="ZLC" D
     33 . . N COMP,CID,CODE,CSYS
     34 . . K DA,^ORD(101.43,ORDIFN,10) ;S DIC("P")=$P(^DD(101.43,10,0),U,2)
     35 . . S DA(1)=ORDIFN,DIC="^ORD(101.43,"_DA(1)_",10,",DIC(0)="L",ZLC=LAST
     36 . . F  S ZLC=$O(@ORMSG@(ZLC)) Q:ZLC'>0  Q:$E(@ORMSG@(ZLC),1,3)'="ZLC"  D
     37 . . . S COMP=$P(@ORMSG@(ZLC),"|",5),X=$P(COMP,U,5) I X="" S LAST=ZLC Q
     38 . . . S CID=$P(COMP,U,4)_";"_$P(COMP,U,6) K DIC("DR"),DO,DD
     39 . . . S CODE=$P(COMP,U),CSYS=$P(COMP,U,3) S:+CSYS=99 CSYS=$E(CSYS,3,99)
     40 . . . S DIC("DR")="2///^S X=CID;3///^S X=CODE;4///^S X=CSYS"
     41 . . . D FILE^DICN S LAST=ZLC
     42ZSY . I $D(^ORD(101.43,ORDIFN,2)) D  ; kill old ones first
     43 . . S DA(1)=ORDIFN,DIK="^ORD(101.43,"_DA(1)_",2,"
     44 . . S DA=0 F  S DA=$O(^ORD(101.43,DA(1),2,DA)) Q:DA'>0  D ^DIK
     45 . . K ^ORD(101.43,ORDIFN,2),DIK,DA
     46 . S NEXT=$O(@ORMSG@(LAST)) I NEXT,$E(@ORMSG@(NEXT),1,3)="ZSY" D
     47 . . K DA,DIC S DA(1)=ORDIFN,DIC="^ORD(101.43,"_DA(1)_",2,"
     48 . . S DIC(0)="L",ZSY=LAST ;,DIC("P")=$P(^DD(101.43,1,0),U,2)
     49 . . F  S ZSY=$O(@ORMSG@(+ZSY)) Q:ZSY'>0  Q:$E(@ORMSG@(ZSY),1,3)'="ZSY"  D
     50 . . . S X=$P(@ORMSG@(ZSY),"|",3),LAST=ZSY
     51 . . . K DD,DO D:$L(X) FILE^DICN
     52NTE . K ^ORD(101.43,ORDIFN,8) ; replace text
     53 . S NEXT=$O(@ORMSG@(LAST)) I NEXT,$E(@ORMSG@(NEXT),1,3)="NTE" D
     54 . . S NTE=LAST,DA=0
     55 . . F  S NTE=$O(@ORMSG@(NTE)) Q:NTE'>0  Q:$E(@ORMSG@(NTE),1,3)'="NTE"  S DA=DA+1,^ORD(101.43,ORDIFN,8,DA,0)=$P(@ORMSG@(NTE),"|",4) I $O(@ORMSG@(NTE,0)) D
     56 . . . S I=0 F  S I=$O(@ORMSG@(NTE,I)) Q:I'>0  S DA=DA+1,^ORD(101.43,ORDIFN,8,DA,0)=@ORMSG@(NTE,I)
     57 . . S ^ORD(101.43,ORDIFN,8,0)="^^"_DA_U_DA_U_DT_U
     58 Q
     59 ;
     60NMSP(NAME) ; -- returns namespace for package
     61 I NAME="RADIOLOGY" Q "RA"
     62 I NAME="IMAGING" Q "RA"
     63 I NAME="LABORATORY" Q "LR"
     64 I NAME="DIETETICS" Q "FH"
     65 I NAME="PHARMACY" Q "PS"
     66 I NAME="CONSULTS" Q "CS"
     67 I NAME="PROCEDURES" Q "CS"
     68 Q ""
     69 ;
     70CREATE(X) ; -- Create new item in #101.43
     71 Q:'$L($G(X)) 0 N HDR,LAST,TOTAL,I
     72 L +^ORD(101.43,0):1 Q:'$T 0
     73 S HDR=$G(^ORD(101.43,0)) Q:HDR="" 0
     74 S LAST=$P(HDR,U,3),TOTAL=$P(HDR,U,4)
     75 F I=(LAST+1):1 Q:'$D(^ORD(101.43,I,0))
     76 S ^ORD(101.43,I,0)=X,X=$E(X,1,30),^ORD(101.43,"B",$$UP^XLFSTR(X),I)=""
     77 S $P(^ORD(101.43,0),U,3,4)=I_U_(TOTAL+1)
     78 L -^ORD(101.43,0)
     79 Q I
     80 ;
     81FH ; -- Dietetics
     82 S X=$P(ZPKG,"|",2),ORFLD(111.1)=$S(X="":"@",1:X)
     83 S X=$P(ZPKG,"|",3),ORFLD(111.2)=$S(X="":"@",1:X)
     84 S X=$P(ZPKG,"|",5),ORFLD(111.3)=$S(X="":"@",1:X)
     85 F NUM=111.1,111.2,111.3 D VAL^DIE(101.43,ORFIEN,NUM,"F",ORFLD(NUM),.ORY,"ORFDA")
     86 K ^ORD(101.43,ORDIFN,8) S X=$P(ZPKG,"|",4)
     87 I $L(X) S ^ORD(101.43,ORDIFN,8,0)="^^1^1^"_DT_U,^(1,0)=X
     88 Q
     89 ;
     90LR ; -- Laboratory
     91 S X=$P(ZPKG,"|",2),ORFLD(60.1)=$S(X="":"@",1:X)
     92 S X=$P(ZPKG,"|",3),ORFLD(60.2)=$S(X="":"@",1:X)
     93 ;S X=$P(ZPKG,"|",4),ORFLD(60.3)=$S(X="":"@",1:X)
     94 S X=$P(ZPKG,"|",5),ORFLD(60.6)=$S(X="":"@",1:X)
     95 S X=$P(ZPKG,"|",6),ORFLD(60.4)=$S(X="":"@",1:X)
     96 S X=$P(ZPKG,"|",7),ORFLD(60.5)=$S(X="":"@",1:X)
     97 S X=$P(ZPKG,"|",8),ORFLD(6)=$S(X="":"@",1:X)
     98 S X=$P(ZPKG,"|",9),ORFLD(60.7)=$S(X="":"@",1:X)
     99 F NUM=6,60.1,60.2,60.4,60.5,60.6,60.7 D VAL^DIE(101.43,ORFIEN,NUM,"F",ORFLD(NUM),.ORY,"ORFDA")
     100 Q
     101 ;
     102PS ; -- Pharmacy
     103 S X=$P(ZPKG,"|",2)
     104 ;S ORFDA(101.43,ORFIEN,50.1)=$S(X'["I":0,$L($P($P(ORDITEM,U,5),"~",3)):2,1:1)
     105 S ORFDA(101.43,ORFIEN,50.1)=$S(X["V":2,X["I":1,1:0) ;inpt or iv med
     106 S ORFDA(101.43,ORFIEN,50.2)=(X["O") ;outpt med
     107 S ORFDA(101.43,ORFIEN,50.3)=(X["B") ;fluid base/soln
     108 S ORFDA(101.43,ORFIEN,50.4)=(X["A") ;fluid additive
     109 S ORFDA(101.43,ORFIEN,50.5)=(X["S") ;supply item
     110 S ORFDA(101.43,ORFIEN,50.7)=(X["N") ;non-VA med
     111 S X=$P(ZPKG,"|",3),ORFDA(101.43,ORFIEN,50.6)=$S(X:1,1:0)
     112 Q
     113 ;
     114RA ; -- Radiology/Nuc Medicine
     115 S X=$P(ZPKG,"|",4),ORFLD(6)=$S(X="":"@",1:X)
     116 S X=$P(ZPKG,"|",5),ORFLD(71.1)=$S(X="":"@",1:X)
     117 S X=$P(ZPKG,"|",7),ORFLD(71.2)=$S(X="":"@",1:X)
     118 S X=$P(ZPKG,"|",2),ORFLD(71.3)=$S(X="":"@",1:X)
     119 S ORFLD(71.4)=$S($P(ZPKG,"|",6)="Y":1,1:0)
     120 S ORFLD(7)=$S($P(ZPKG,"|",3)="Y":2,1:1)
     121 F NUM=6,7,71.1,71.2,71.3,71.4 D VAL^DIE(101.43,ORFIEN,NUM,"F",ORFLD(NUM),.ORY,"ORFDA")
     122 Q
     123 ;
     124CS ; -- Consults/Requests
     125 S X=$P(ZPKG,"|",2),ORFLD(123.1)=$S(X="":"@",1:X)
     126 D VAL^DIE(101.43,ORFIEN,123.1,"F",ORFLD(123.1),.ORY,"ORFDA")
     127 Q
Note: See TracChangeset for help on using the changeset viewer.