PSJBCMA2.m

PSJBCMA2 ;BIR/MV-RETURN INPATIENT ACTIVITY LOG ;16 Mar 99 / 11:43 AM

 ;;5.0; INPATIENT MEDICATIONS ;**32,41,54,56,81**;16 DEC 97

 ;

 ;Reference to ^PS(55 is supported by DBIA 2191

 ;

EN(DFN,ON,PSJTMP)         ;

 NEW X,Y

 S PSJINX=0

 S PSJTMP=$S($G(PSJTMP)=1:"PSJ2",1:"PSJ")

 I $G(ON)["U",$D(^PS(55,+$G(DFN),5,+ON)) D UD

 I $G(ON)["V",$D(^PS(55,+$G(DFN),"IV",+ON)) D IV

 I '$D(^TMP(PSJTMP,$J,0)) S ^(0)=-1

 K PSJINX

 Q

UD ;Get Activity Log for Unit Dose order.

 F PSJAL=0:0 S PSJAL=$O(^PS(55,DFN,5,+ON,9,PSJAL)) Q:'PSJAL  D

 . S X=$G(^PS(55,DFN,5,+ON,9,PSJAL,0))

 . S PSJ("DATE")=$P(X,U)

 . S (PSJ("USER"),PSJ("UIEN"))=$P(X,U,2),PSJ("FIELD")=$P(X,U,4)

 . S PSJ("OLD DATA")=$P(X,U,5)

 . S PSJ("ACTION")=$P($G(^PS(53.3,+$P(X,U,3),0)),U)

 . D TMP K PSJ

 K PSJAL

 Q

IV ;Get Activity Log for IV order.

 F PSJAL=0:0 S PSJAL=$O(^PS(55,DFN,"IV",+ON,"A",PSJAL)) Q:'PSJAL  D

 . K PSJ,PSJDD

 . S X=$G(^PS(55,DFN,"IV",+ON,"A",PSJAL,0))

 . S PSJ("DATE")=$P(X,U,5)

 . S PSJ("ACTION")=$P(X,U,2) Q:PSJ("ACTION")="F"

 . S PSJ("USER")=$P(X,U,3)

 . S PSJ("REASON")=$P(X,U,4)

 . S PSJ("ACTION")=$$CODES^PSIVUTL(PSJ("ACTION"),55.04,.02)

 . S PSJ("UIEN")=$P(X,U,6)

 . I $O(^PS(55,DFN,"IV",+ON,"A",PSJAL,1,0))="" D TMP

 . F PSJFC=0:0 S PSJFC=$O(^PS(55,DFN,"IV",+ON,"A",PSJAL,1,PSJFC)) Q:'PSJFC  D

 .. S X=$G(^PS(55,DFN,"IV",+ON,"A",PSJAL,1,PSJFC,0))

 .. K PSJ("FIELD"),PSJ("OLD DATA")

 .. S PSJ("FIELD")=$P(X,U)

 .. S PSJ("OLD DATA")=$P(X,U,2)

 .. D TMP

 K PSJ,PSJAL,PSJFC

 Q

TMP ;Setup ^TMP

 S PSJINX=PSJINX+1

 I +PSJ("USER") D NAME^PSJBCMA1(+PSJ("USER"),.X,"") S PSJ("USER")=X

 S ^TMP(PSJTMP,$J,0)=DFN_U_+ON_U_ON_U_PSJINX

 S ^TMP(PSJTMP,$J,PSJINX,1)=PSJ("DATE")_U_PSJ("USER")_U_$G(PSJ("FIELD"))_U_PSJ("ACTION")_U_$G(PSJ("UIEN"))

 S:$G(PSJ("OLD DATA"))]"" ^TMP(PSJTMP,$J,PSJINX,2)=PSJ("OLD DATA")

 S:$G(PSJ("REASON"))]"" ^TMP(PSJTMP,$J,PSJINX,3)=PSJ("REASON")

 Q

GETFLD  ;

 N X D FIELD^DID(55.04,.02,"","POINTER","PSJDD") Q

PSJBCMA2  ;BIR/MV-RETURN INPATIENT ACTIVITY LOG ;16 Mar 99 / 11:43 AM

 +1       ;;5.0; INPATIENT MEDICATIONS ;**32,41,54,56,81**;16 DEC 97

 +2       ;

 +3       ;Reference to ^PS(55 is supported by DBIA 2191

 +4       ;

EN(DFN,ON,PSJTMP) ;

 +1        NEW X,Y

 +2        SET PSJINX=0

 +3        SET PSJTMP=$SELECT($GET(PSJTMP)=1:"PSJ2",1:"PSJ")

 +4        IF $GET(ON)["U"

               IF $DATA(^PS(55,+$GET(DFN),5,+ON))

                   DO UD

 +5        IF $GET(ON)["V"

               IF $DATA(^PS(55,+$GET(DFN),"IV",+ON))

                   DO IV

 +6        IF '$DATA(^TMP(PSJTMP,$JOB,0))

               SET ^(0)=-1

 +7        KILL PSJINX

 +8        QUIT 

UD        ;Get Activity Log for Unit Dose order.

 +1        FOR PSJAL=0:0

               SET PSJAL=$ORDER(^PS(55,DFN,5,+ON,9,PSJAL))

               IF 'PSJAL

                   QUIT 

               Begin DoDot:1

 +2                SET X=$GET(^PS(55,DFN,5,+ON,9,PSJAL,0))

 +3                SET PSJ("DATE")=$PIECE(X,U)

 +4                SET (PSJ("USER"),PSJ("UIEN"))=$PIECE(X,U,2)

                   SET PSJ("FIELD")=$PIECE(X,U,4)

 +5                SET PSJ("OLD DATA")=$PIECE(X,U,5)

 +6                SET PSJ("ACTION")=$PIECE($GET(^PS(53.3,+$PIECE(X,U,3),0)),U)

 +7                DO TMP

                   KILL PSJ

               End DoDot:1

 +8        KILL PSJAL

 +9        QUIT 

IV        ;Get Activity Log for IV order.

 +1        FOR PSJAL=0:0

               SET PSJAL=$ORDER(^PS(55,DFN,"IV",+ON,"A",PSJAL))

               IF 'PSJAL

                   QUIT 

               Begin DoDot:1

 +2                KILL PSJ,PSJDD

 +3                SET X=$GET(^PS(55,DFN,"IV",+ON,"A",PSJAL,0))

 +4                SET PSJ("DATE")=$PIECE(X,U,5)

 +5                SET PSJ("ACTION")=$PIECE(X,U,2)

                   IF PSJ("ACTION")="F"

                       QUIT 

 +6                SET PSJ("USER")=$PIECE(X,U,3)

 +7                SET PSJ("REASON")=$PIECE(X,U,4)

 +8                SET PSJ("ACTION")=$$CODES^PSIVUTL(PSJ("ACTION"),55.04,.02)

 +9                SET PSJ("UIEN")=$PIECE(X,U,6)

 +10               IF $ORDER(^PS(55,DFN,"IV",+ON,"A",PSJAL,1,0))=""

                       DO TMP

 +11               FOR PSJFC=0:0

                       SET PSJFC=$ORDER(^PS(55,DFN,"IV",+ON,"A",PSJAL,1,PSJFC))

                       IF 'PSJFC

                           QUIT 

                       Begin DoDot:2

 +12                       SET X=$GET(^PS(55,DFN,"IV",+ON,"A",PSJAL,1,PSJFC,0))

 +13                       KILL PSJ("FIELD"),PSJ("OLD DATA")

 +14                       SET PSJ("FIELD")=$PIECE(X,U)

 +15                       SET PSJ("OLD DATA")=$PIECE(X,U,2)

 +16                       DO TMP

                       End DoDot:2

               End DoDot:1

 +17       KILL PSJ,PSJAL,PSJFC

 +18       QUIT 

TMP       ;Setup ^TMP

 +1        SET PSJINX=PSJINX+1

 +2        IF +PSJ("USER")

               DO NAME^PSJBCMA1(+PSJ("USER"),.X,"")

               SET PSJ("USER")=X

 +3        SET ^TMP(PSJTMP,$JOB,0)=DFN_U_+ON_U_ON_U_PSJINX

 +4        SET ^TMP(PSJTMP,$JOB,PSJINX,1)=PSJ("DATE")_U_PSJ("USER")_U_$GET(PSJ("FIELD"))_U_PSJ("ACTION")_U_$GET(PSJ("UIEN"))

 +5        IF $GET(PSJ("OLD DATA"))]""

               SET ^TMP(PSJTMP,$JOB,PSJINX,2)=PSJ("OLD DATA")

 +6        IF $GET(PSJ("REASON"))]""

               SET ^TMP(PSJTMP,$JOB,PSJINX,3)=PSJ("REASON")

 +7        QUIT 

GETFLD    ;

 +1        NEW X

           DO FIELD^DID(55.04,.02,"","POINTER","PSJDD")

           QUIT