RORHL07.m

RORHL07 ;HOIFO/BH - HL7 INPATIENT PHARMACY: ORC,RXE ; 5/22/06 1:29pm

 ;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24

 ;

 ; This routine uses the following IAs:

 ;

 ; #93           Get stop code from the file #44 (controlled)

 ; #1876         Read access to file #59 (controlled)

 ; #10040        Read the INSTITUTION field of file #44 (supported)

 ; #10060        Read access to file #200 (supported)

 ; #10090        Read access to file #4 (supported)

 ;

 Q

 ;

 ;***** INPATIENT PHARMACY ORC SEGMENT BUILDER

 ;

 ; NODE          Closed root of a subtree that stores the output of

 ;               the PSS432^PSS55 Pharmacy API

 ;

 ; .RORORC       Array with info (from OEL^PSOORRL)

 ;

 ; Return Values:

 ;       <0  Error Code

 ;        0  Ok

 ;       >0  Non-fatal error(s)

 ;

ORC(NODE,RORORC) ;

 N BUF,CS,ERRCNT,IEN42,IEN44,RC,RORMSG,RORSEG,TMP

 S (ERRCNT,RC)=0

 D ECH^RORHL7(.CS)

 ;

 ;--- Initialize the segment

 S RORSEG(0)="ORC"

 ;

 ;--- ORC-1 - Order Control 

 S RORSEG(1)="NW"

 ;

 ;--- ORC-2 - Placer Order Number

 S RORSEG(2)=RORDFN_"V"_$P($G(@NODE@(.01)),U)_CS_"IP"

 ;

 ;--- ORC-12 - Provider

 S BUF=+$P($G(RORORC("P",0)),U)

 I BUF>0  D

 . S $P(BUF,CS,13)=$$GET1^DIQ(200,+BUF_",",53.5,"E",,"RORMSG")

 . I $G(DIERR)  D  S ERRCNT=ERRCNT+1

 . . D DBS^RORERR("RORMSG",-99,,,200,+BUF_",")

 . S RORSEG(12)=BUF

 ;

 ;--- ORC-15 - Order Date/Time

 S TMP=$$FMTHL7^XLFDT($P($G(RORORC(0)),U,5))

 Q:TMP'>0 $$ERROR^RORERR(-100,,,,"No order date","OEL^PSOORRL")

 S RORSEG(15)=TMP

 ;

 ;--- ORC-16 - Control Code Reason

 S RORSEG(16)=CS_CS_CS_CS_"NEW"

 ;

 ;--- ORC-17 - Division

 S IEN42=+$P($G(@NODE@(9)),U)

 I IEN42>0  D

 . S IEN44=+$$GET1^DIQ(42,IEN42_",",44,"I",,"RORMSG")

 . I $G(DIERR)  D  S ERRCNT=ERRCNT+1

 . . D DBS^RORERR("RORMSG",-99,,,42,IEN42_",")

 E  S IEN44=0

 S RORSEG(17)=$$DIV44^RORHLUT1(IEN44,CS)

 ;

 ;--- Store the segment

 D ADDSEG^RORHL7(.RORSEG)

 Q ERRCNT

 ;

 ;***** INPATIENT PHARMACY RXE SEGMENT BUILDER

 ;

 ; NODE          Closed root of a subtree that stores the output of

 ;               the PSS432^PSS55 Pharmacy API

 ;

 ; .RORRXE       Array containing info (from OEL^PSJORRL)

 ;

 ; Return Values:

 ;       <0  Error Code

 ;        0  Ok

 ;       >0  Non-fatal error(s)

 ;

RXE(NODE,RORRXE) ;

 N BUF,CS,ERRCNT,IDGN,II,INDF,RC,RORMSG,RORMR,ROROUT,RORUOUT,RORQT,RORSEG,TMP

 Q:$P($G(RORRXE(0)),U)="" 0

 D ECH^RORHL7(.CS)

 S (ERRCNT,RC)=0

 ;

 ;--- Load the data

 S RORMR=$$ESCAPE^RORHL7($P($G(@NODE@(3)),U,2))

 S TMP=$P($G(@NODE@(26)),U),RORQT=""

 S:TMP'="" $P(RORQT,CS,8)=$$ESCAPE^RORHL7(TMP)

 ;

 S II=0

 F  S II=$O(RORRXE("DD",II)) Q:II=""  D  Q:RC<0

 . K ROROUT,RORSEG

 . ;--- Initialize the segment

 . S RORSEG(0)="RXE"

 . ;

 . ;--- RXE-1 - Quantity/Timing

 . S RORSEG(1)=RORQT

 . ;

 . ;--- RXE-2 - Give Code

 . S IDGN=+$P($G(RORRXE("DD",II,0)),U)

 . S:IDGN'>0 IDGN=+$P($G(RORRXE("DD",II,0)),U,3)  Q:IDGN'>0

 . S BUF="",TMP=$$RXE2^RORHL031(IDGN,CS,.BUF,.INDF)

 . I TMP  S ERRCNT=ERRCNT+1  Q:TMP<0

 . Q:BUF=""

 . S RORSEG(2)=BUF

 . ;

 . ;--- RXE-3 - Give Amount (Min)

 . S RORSEG(3)=""""""

 . ;

 . ;--- RXE-5 - Give Units

 . S TMP=$$RXE5^RORHL031(+$G(INDF),CS,.BUF)

 . S:TMP ERRCNT=ERRCNT+1

 . S:BUF'="" RORSEG(5)=BUF

 . ;

 . ;--- RXE-18 - Stop Date/Time

 . S TMP=$P($G(RORRXE(0)),U,3)

 . S RORSEG(18)=$$FM2HL^RORHL7(TMP)

 . ;

 . ;--- RXE-21 - Medication Route

 . S:RORMR'="" RORSEG(21)=RORMR

 . ;

 . ;--- RXE-24 - Units per dose

 . S TMP=$P($G(RORRXE("DD",II,0)),U,2)

 . S:TMP'="" RORSEG(24)=+TMP

 . ;

 . ;--- Store the segment

 . D ADDSEG^RORHL7(.RORSEG)

 ;

 Q ERRCNT

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---RORHL07   3634     printed  Mar 13, 2025@20:46:30                                                                                                                                                                                                     Page 2

RORHL07   ;HOIFO/BH - HL7 INPATIENT PHARMACY: ORC,RXE ; 5/22/06 1:29pm

 +1       ;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24

 +2       ;

 +3       ; This routine uses the following IAs:

 +4       ;

 +5       ; #93           Get stop code from the file #44 (controlled)

 +6       ; #1876         Read access to file #59 (controlled)

 +7       ; #10040        Read the INSTITUTION field of file #44 (supported)

 +8       ; #10060        Read access to file #200 (supported)

 +9       ; #10090        Read access to file #4 (supported)

 +10      ;

 +11       QUIT 

 +12      ;

 +13      ;***** INPATIENT PHARMACY ORC SEGMENT BUILDER

 +14      ;

 +15      ; NODE          Closed root of a subtree that stores the output of

 +16      ;               the PSS432^PSS55 Pharmacy API

 +17      ;

 +18      ; .RORORC       Array with info (from OEL^PSOORRL)

 +19      ;

 +20      ; Return Values:

 +21      ;       <0  Error Code

 +22      ;        0  Ok

 +23      ;       >0  Non-fatal error(s)

 +24      ;

ORC(NODE,RORORC) ;

 +1        NEW BUF,CS,ERRCNT,IEN42,IEN44,RC,RORMSG,RORSEG,TMP

 +2        SET (ERRCNT,RC)=0

 +3        DO ECH^RORHL7(.CS)

 +4       ;

 +5       ;--- Initialize the segment

 +6        SET RORSEG(0)="ORC"

 +7       ;

 +8       ;--- ORC-1 - Order Control 

 +9        SET RORSEG(1)="NW"

 +10      ;

 +11      ;--- ORC-2 - Placer Order Number

 +12       SET RORSEG(2)=RORDFN_"V"_$PIECE($GET(@NODE@(.01)),U)_CS_"IP"

 +13      ;

 +14      ;--- ORC-12 - Provider

 +15       SET BUF=+$PIECE($GET(RORORC("P",0)),U)

 +16       IF BUF>0

               Begin DoDot:1

 +17               SET $PIECE(BUF,CS,13)=$$GET1^DIQ(200,+BUF_",",53.5,"E",,"RORMSG")

 +18               IF $GET(DIERR)

                       Begin DoDot:2

 +19                       DO DBS^RORERR("RORMSG",-99,,,200,+BUF_",")

                       End DoDot:2

                       SET ERRCNT=ERRCNT+1

 +20               SET RORSEG(12)=BUF

               End DoDot:1

 +21      ;

 +22      ;--- ORC-15 - Order Date/Time

 +23       SET TMP=$$FMTHL7^XLFDT($PIECE($GET(RORORC(0)),U,5))

 +24       if TMP'>0

               QUIT $$ERROR^RORERR(-100,,,,"No order date","OEL^PSOORRL")

 +25       SET RORSEG(15)=TMP

 +26      ;

 +27      ;--- ORC-16 - Control Code Reason

 +28       SET RORSEG(16)=CS_CS_CS_CS_"NEW"

 +29      ;

 +30      ;--- ORC-17 - Division

 +31       SET IEN42=+$PIECE($GET(@NODE@(9)),U)

 +32       IF IEN42>0

               Begin DoDot:1

 +33               SET IEN44=+$$GET1^DIQ(42,IEN42_",",44,"I",,"RORMSG")

 +34               IF $GET(DIERR)

                       Begin DoDot:2

 +35                       DO DBS^RORERR("RORMSG",-99,,,42,IEN42_",")

                       End DoDot:2

                       SET ERRCNT=ERRCNT+1

               End DoDot:1

 +36      IF '$TEST

               SET IEN44=0

 +37       SET RORSEG(17)=$$DIV44^RORHLUT1(IEN44,CS)

 +38      ;

 +39      ;--- Store the segment

 +40       DO ADDSEG^RORHL7(.RORSEG)

 +41       QUIT ERRCNT

 +42      ;

 +43      ;***** INPATIENT PHARMACY RXE SEGMENT BUILDER

 +44      ;

 +45      ; NODE          Closed root of a subtree that stores the output of

 +46      ;               the PSS432^PSS55 Pharmacy API

 +47      ;

 +48      ; .RORRXE       Array containing info (from OEL^PSJORRL)

 +49      ;

 +50      ; Return Values:

 +51      ;       <0  Error Code

 +52      ;        0  Ok

 +53      ;       >0  Non-fatal error(s)

 +54      ;

RXE(NODE,RORRXE) ;

 +1        NEW BUF,CS,ERRCNT,IDGN,II,INDF,RC,RORMSG,RORMR,ROROUT,RORUOUT,RORQT,RORSEG,TMP

 +2        if $PIECE($GET(RORRXE(0)),U)=""

               QUIT 0

 +3        DO ECH^RORHL7(.CS)

 +4        SET (ERRCNT,RC)=0

 +5       ;

 +6       ;--- Load the data

 +7        SET RORMR=$$ESCAPE^RORHL7($PIECE($GET(@NODE@(3)),U,2))

 +8        SET TMP=$PIECE($GET(@NODE@(26)),U)

           SET RORQT=""

 +9        if TMP'=""

               SET $PIECE(RORQT,CS,8)=$$ESCAPE^RORHL7(TMP)

 +10      ;

 +11       SET II=0

 +12       FOR 

               SET II=$ORDER(RORRXE("DD",II))

               if II=""

                   QUIT 

               Begin DoDot:1

 +13               KILL ROROUT,RORSEG

 +14      ;--- Initialize the segment

 +15               SET RORSEG(0)="RXE"

 +16      ;

 +17      ;--- RXE-1 - Quantity/Timing

 +18               SET RORSEG(1)=RORQT

 +19      ;

 +20      ;--- RXE-2 - Give Code

 +21               SET IDGN=+$PIECE($GET(RORRXE("DD",II,0)),U)

 +22               if IDGN'>0

                       SET IDGN=+$PIECE($GET(RORRXE("DD",II,0)),U,3)

                   if IDGN'>0

                       QUIT 

 +23               SET BUF=""

                   SET TMP=$$RXE2^RORHL031(IDGN,CS,.BUF,.INDF)

 +24               IF TMP

                       SET ERRCNT=ERRCNT+1

                       if TMP<0

                           QUIT 

 +25               if BUF=""

                       QUIT 

 +26               SET RORSEG(2)=BUF

 +27      ;

 +28      ;--- RXE-3 - Give Amount (Min)

 +29               SET RORSEG(3)=""""""

 +30      ;

 +31      ;--- RXE-5 - Give Units

 +32               SET TMP=$$RXE5^RORHL031(+$GET(INDF),CS,.BUF)

 +33               if TMP

                       SET ERRCNT=ERRCNT+1

 +34               if BUF'=""

                       SET RORSEG(5)=BUF

 +35      ;

 +36      ;--- RXE-18 - Stop Date/Time

 +37               SET TMP=$PIECE($GET(RORRXE(0)),U,3)

 +38               SET RORSEG(18)=$$FM2HL^RORHL7(TMP)

 +39      ;

 +40      ;--- RXE-21 - Medication Route

 +41               if RORMR'=""

                       SET RORSEG(21)=RORMR

 +42      ;

 +43      ;--- RXE-24 - Units per dose

 +44               SET TMP=$PIECE($GET(RORRXE("DD",II,0)),U,2)

 +45               if TMP'=""

                       SET RORSEG(24)=+TMP

 +46      ;

 +47      ;--- Store the segment

 +48               DO ADDSEG^RORHL7(.RORSEG)

               End DoDot:1

               if RC<0

                   QUIT 

 +49      ;

 +50       QUIT ERRCNT