MCAPI.m

MCAPI ; CIOFO/MD - Print result from a medicine file

 ;;2.3;Medicine;**27**;09/13/1996

 ;;**DBIA #3042**

 ;

 ; RESULT= variable pointer to a medicine file entry

 ;         (e.g. "12;MCAR(691.5,") (required).

 ;

 ; MCFLG =1 if report to be headerless (optional)

 ;

EN(RESULT,MCFLG) ; Print result from a medicine file

 N XQY0,MCARGRTN,PR,DISTP,DILCT,NUM,NAME,PRE,TSUP2,TT,TY,HOSP,ORVP,DA,MCARGDA,OT,MCARPPS,MCPRO,DFN,RDATE,SCD

 S XQY0="",OT=$$SINGLE^MCAPI(RESULT)

 I OT="" W !,"***** BAD MEDICINE FILE POINTER  *****",! Q

 S (DA,MCARGDA)=$P(OT,U,2),MCARPPS=$P(OT,U,3,4),MCPRO=$P(OT,U,11),DFN=$P(OT,U,13),ORVP=DFN_"DPT("

 D MCPPROC^MCARP

 S MCARGRTN=$P(OT,U,5)

 D @MCARPPS

 K %I

 Q

SINGLE(RESULT) ;  Function to return info on single proceedure.

 ;

 ; RESULT = variable pointer to a medicine file

 ;          (e.g. "12;MCAR(691.5,") (required)

 ;

 N VALUE,ZNODE,S4,S5,S6,WH,DFN,J,K,L,LL,LL1,M,MCARCODE,MCARDT,MCARPROC,MCESKEY,MCESSEC,MCFILE,PR,S1,S2

 S S6=+$G(RESULT) ;ien from medicine file

 S S5=$P($P($G(RESULT),";",2),",") ;S5 is the root of the medicine file, no ^ or ,

 S ZNODE=$G(@("^"_S5_","_S6_",0)")) ;zero node from record S6 in file S5

 I $G(ZNODE)="" S VALUE="" G KILL

 D:'($G(ZNODE)="")

 . S S4=9999999.9999-($P(ZNODE,"^")) ;S4 is proceedure time/date

 . S DFN=$P(ZNODE,"^",2),WH=""

 . Q

 D CONT^MCARPS2,PR0^MCARPS2 ;return single ^TMP("MCAR",$J,"GMRC", node

 S ^TMP("MCAR",$J,"GMRC","OT",1)=$G(^TMP("OR",$J,"MCAR","OT",1)),VALUE=$S($G(^TMP("MCAR",$J,"GMRC","OT",1))'="":^TMP("MCAR",$J,"GMRC","OT",1)_"^"_DFN,1:"")

KILL K ^TMP("MCAR",$J,"GMRC"),^TMP("OR",$J,"MCAR")

 Q VALUE

MCAPI     ; CIOFO/MD - Print result from a medicine file

 +1       ;;2.3;Medicine;**27**;09/13/1996

 +2       ;;**DBIA #3042**

 +3       ;

 +4       ; RESULT= variable pointer to a medicine file entry

 +5       ;         (e.g. "12;MCAR(691.5,") (required).

 +6       ;

 +7       ; MCFLG =1 if report to be headerless (optional)

 +8       ;

EN(RESULT,MCFLG) ; Print result from a medicine file

 +1        NEW XQY0,MCARGRTN,PR,DISTP,DILCT,NUM,NAME,PRE,TSUP2,TT,TY,HOSP,ORVP,DA,MCARGDA,OT,MCARPPS,MCPRO,DFN,RDATE,SCD

 +2        SET XQY0=""

           SET OT=$$SINGLE^MCAPI(RESULT)

 +3        IF OT=""

               WRITE !,"***** BAD MEDICINE FILE POINTER  *****",!

               QUIT 

 +4        SET (DA,MCARGDA)=$PIECE(OT,U,2)

           SET MCARPPS=$PIECE(OT,U,3,4)

           SET MCPRO=$PIECE(OT,U,11)

           SET DFN=$PIECE(OT,U,13)

           SET ORVP=DFN_"DPT("

 +5        DO MCPPROC^MCARP

 +6        SET MCARGRTN=$PIECE(OT,U,5)

 +7        DO @MCARPPS

 +8        KILL %I

 +9        QUIT 

SINGLE(RESULT) ;  Function to return info on single proceedure.

 +1       ;

 +2       ; RESULT = variable pointer to a medicine file

 +3       ;          (e.g. "12;MCAR(691.5,") (required)

 +4       ;

 +5        NEW VALUE,ZNODE,S4,S5,S6,WH,DFN,J,K,L,LL,LL1,M,MCARCODE,MCARDT,MCARPROC,MCESKEY,MCESSEC,MCFILE,PR,S1,S2

 +6       ;ien from medicine file

           SET S6=+$GET(RESULT)

 +7       ;S5 is the root of the medicine file, no ^ or ,

           SET S5=$PIECE($PIECE($GET(RESULT),";",2),",")

 +8       ;zero node from record S6 in file S5

           SET ZNODE=$GET(@("^"_S5_","_S6_",0)"))

 +9        IF $GET(ZNODE)=""

               SET VALUE=""

               GOTO KILL

 +10       IF '($GET(ZNODE)="")

               Begin DoDot:1

 +11      ;S4 is proceedure time/date

                   SET S4=9999999.9999-($PIECE(ZNODE,"^"))

 +12               SET DFN=$PIECE(ZNODE,"^",2)

                   SET WH=""

 +13               QUIT 

               End DoDot:1

 +14      ;return single ^TMP("MCAR",$J,"GMRC", node

           DO CONT^MCARPS2

           DO PR0^MCARPS2

 +15       SET ^TMP("MCAR",$JOB,"GMRC","OT",1)=$GET(^TMP("OR",$JOB,"MCAR","OT",1))

           SET VALUE=$SELECT($GET(^TMP("MCAR",$JOB,"GMRC","OT",1))'="":^TMP("MCAR",$JOB,"GMRC","OT",1)_"^"_DFN,1:"")

KILL       KILL ^TMP("MCAR",$JOB,"GMRC"),^TMP("OR",$JOB,"MCAR")

 +1        QUIT VALUE