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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCAPI 1624 printed Dec 13, 2024@02:11:45 Page 2
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
