PSJ53P46.m

PSJ53P46 ;SLC/JLC - API FOR INFORMATION FROM FILE 53.46; ;12/21/15  12:14

 ;;5.0;INPATIENT MEDICATIONS;**307**;16 DEC 97;Build 18

 ;

 ;

 ;

ALL(PSJIEN,LIST) ;

 ;PSJIEN - IEN of CLINIC from the HOSPITAL LOCATION file (#44).

 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the

 ;       Field Number of the data piece being returned.

 ;Returns NUMBER OF DAYS UNTIL STOP (#1), AUTO-DC IMO ORDERS (#2), SEND TO BCMA? (#3)

 ;        IMO DC/EXPIRED DATE LIMIT (#6), PRE-EXCHANGE REPORT DEVICE (#5), MISSING DOSE PRINTER (#4)

 N PSJ53P46,PSJ,PSJIEN2,PSJIEN3

 I $G(LIST)="" Q

 K ^TMP($J,LIST)

 I $G(PSJIEN)="" S ^TMP($J,LIST,0)="-1^NO CLINIC SPECIFIED" Q

 I $G(PSJIEN)]"",+$G(PSJIEN)'>0 S ^TMP($J,LIST,0)="-1^NO DATA FOUND" Q

 I $G(PSJIEN)]"",'$D(^PS(53.46,"B",PSJIEN)) S ^TMP($J,LIST,0)="-1^NO DATA FOUND"

 S PSJIEN3=$O(^PS(53.46,"B",PSJIEN,""))

 I +$G(PSJIEN3)>0 D

 . S ^TMP($J,LIST,0)=1

 . D GETS^DIQ(53.46,+PSJIEN3,"1;2;3;4;5;6","IE","PSJ53P46")

 . S PSJ(1)=$O(PSJ53P46(53.46,"")) Q:'PSJ(1)  D SETALL

 K ^TMP("DILIST",$J)

 Q

 ;

SETALL ;

 N I

 F I=1:1:6 S ^TMP($J,LIST,1,I)=$G(PSJ53P46(53.46,PSJ(1),I,"I"))_"^"_$G(PSJ53P46(53.46,PSJ(1),I,"E"))

 Q

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSJ53P46   1218     printed  Apr 09, 2024@21:03:38                                                                                                                                                                                                    Page 2

PSJ53P46  ;SLC/JLC - API FOR INFORMATION FROM FILE 53.46; ;12/21/15  12:14

 +1       ;;5.0;INPATIENT MEDICATIONS;**307**;16 DEC 97;Build 18

 +2       ;

 +3       ;

 +4       ;

ALL(PSJIEN,LIST) ;

 +1       ;PSJIEN - IEN of CLINIC from the HOSPITAL LOCATION file (#44).

 +2       ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the

 +3       ;       Field Number of the data piece being returned.

 +4       ;Returns NUMBER OF DAYS UNTIL STOP (#1), AUTO-DC IMO ORDERS (#2), SEND TO BCMA? (#3)

 +5       ;        IMO DC/EXPIRED DATE LIMIT (#6), PRE-EXCHANGE REPORT DEVICE (#5), MISSING DOSE PRINTER (#4)

 +6        NEW PSJ53P46,PSJ,PSJIEN2,PSJIEN3

 +7        IF $GET(LIST)=""

               QUIT 

 +8        KILL ^TMP($JOB,LIST)

 +9        IF $GET(PSJIEN)=""

               SET ^TMP($JOB,LIST,0)="-1^NO CLINIC SPECIFIED"

               QUIT 

 +10       IF $GET(PSJIEN)]""

               IF +$GET(PSJIEN)'>0

                   SET ^TMP($JOB,LIST,0)="-1^NO DATA FOUND"

                   QUIT 

 +11       IF $GET(PSJIEN)]""

               IF '$DATA(^PS(53.46,"B",PSJIEN))

                   SET ^TMP($JOB,LIST,0)="-1^NO DATA FOUND"

 +12       SET PSJIEN3=$ORDER(^PS(53.46,"B",PSJIEN,""))

 +13       IF +$GET(PSJIEN3)>0

               Begin DoDot:1

 +14               SET ^TMP($JOB,LIST,0)=1

 +15               DO GETS^DIQ(53.46,+PSJIEN3,"1;2;3;4;5;6","IE","PSJ53P46")

 +16               SET PSJ(1)=$ORDER(PSJ53P46(53.46,""))

                   if 'PSJ(1)

                       QUIT 

                   DO SETALL

               End DoDot:1

 +17       KILL ^TMP("DILIST",$JOB)

 +18       QUIT 

 +19      ;

SETALL    ;

 +1        NEW I

 +2        FOR I=1:1:6

               SET ^TMP($JOB,LIST,1,I)=$GET(PSJ53P46(53.46,PSJ(1),I,"I"))_"^"_$GET(PSJ53P46(53.46,PSJ(1),I,"E"))

 +3        QUIT 

 +4       ;