- 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 Jan 18, 2025@03:12:56 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