PXAPIIB ;ISA/AAS - SUPPORTED REFERENCES FOR AICS ; 12/11/95
;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996
;
; -- Output transforms, used for outputting entry during formatting
; and after scanning before sending to PCE.
; -- called by the package interface file and IBDFBK3
;
DSPLYED(IEN) ; -- function, returns .01 field of entry ien
; -- output transform for Education Topics (file #9999999.09)
; -- example of use: S Y=$$DSPLYED^PXAPIIB(Y)
Q $P($G(^AUTTEDT(+$G(IEN),0)),"^")
;
DSPLYIM(IEN) ; -- function, returns .01 field of entry ien
; -- output transform for Immunizations (file #9999999.14)
Q $P($G(^AUTTIMM(+$G(IEN),0)),"^")
;
DSPLYEX(IEN) ; -- function, returns .01 field of entry ien
; -- output transform for EXAMS (file #9999999.15)
Q $P($G(^AUTTEXAM(+$G(IEN),0)),"^")
;
DSPLYTR(IEN) ; -- function, returns .01 field of entry ien
; -- output transform for TREATMENTS (file #9999999.17)
Q $P($G(^AUTTTRT(+$G(IEN),0)),"^")
;
DSPLYSK(IEN) ; -- function, returns .01 field of entry ien
; -- output transform for Education Topics (file #9999999.28)
Q $P($G(^AUTTSK(+$G(IEN),0)),"^")
;
DSPLYHF(IEN) ; -- function, returns .01 field of entry ien
; -- output transform for Health Factors (file #9999999.64)
Q $P($G(^AUTTHF(+$G(IEN),0)),"^")
;
;
; -- Validation routines, used by the utility to validate active
; entries on a form, called from package interface file.
;
TESTEDT ; -- does X point to a valid Education Topic? Kills X if not.
; input X := pointer to 9999999.09
; output := if valid x=x,y=""
; := if entry not exist x is killed, y=""
; := if entry exist but inactive x is killed, y=.01 field
;
I '$G(X) K X S Y="" Q
I '$D(^AUTTEDT(X,0)) K X S Y="" Q
I $P($G(^AUTTEDT(X,0)),"^",3) S Y=$P(^AUTTEDT(X,0),"^") K X
Q
;
TESTIMM ; -- does X point to a valid Immunization? Kills X if not.
; input X := pointer to 9999999.14
; output := if valid x=x,y=""
; := if entry not exist x is killed, y=""
; := if entry exist but inactive x is killed, y=.01 field
;
I '$G(X) K X S Y="" Q
I '$D(^AUTTIMM(X,0)) K X S Y="" Q
I $P($G(^AUTTIMM(X,0)),"^",7) S Y=$P(^AUTTEDT(X,0),"^") K X
Q
;
TESTEXM ; -- does X point to a valid EXAM? Kills X if not.
; input X := pointer to 9999999.15
; output := if valid x=x,y=""
; := if entry not exist x is killed, y=""
; := if entry exist but inactive x is killed, y=.01 field
;
I '$G(X) K X S Y="" Q
I '$D(^AUTTEXAM(X,0)) K X S Y="" Q
I $P($G(^AUTTEXAM(X,0)),"^",4) S Y=$P(^AUTTEXAM(X,0),"^") K X
Q
;
TESTTRT ; -- does X point to a valid Treatment? Kills X if not.
; input X := pointer to 9999999.17
; output := if valid x=x,y=""
; := if entry not exist x is killed, y=""
; := if entry exist but inactive x is killed, y=.01 field
;
I '$G(X) K X S Y="" Q
I '$D(^AUTTTRT(X,0)) K X S Y="" Q
I $P($G(^AUTTTRT(X,0)),"^",4) S Y=$P(^AUTTTRT(X,0),"^") K X
Q
;
TESTSK ; -- does X point to a valid Skin Test? Kills X if not.
; input X := pointer to 9999999.28
; output := if valid x=x,y=""
; := if entry not exist x is killed, y=""
; := if entry exist but inactive x is killed, y=.01 field
;
I '$G(X) K X S Y="" Q
I '$D(^AUTTSK(X,0)) K X S Y="" Q
I $P($G(^AUTTSK(X,0)),"^",3) S Y=$P(^AUTTSK(X,0),"^") K X
Q
;
TESTHF ; -- does X point to a valid Health Factor? Kills X if not.
; input X := pointer to 9999999.64
; output := if valid x=x,y=""
; := if entry not exist x is killed, y=""
; := if entry exist but inactive x is killed, y=.01 field
;
I '$G(X) K X S Y="" Q
I '$D(^AUTTHF(X,0)) K X S Y="" Q
I $P($G(^AUTTHF(X,0)),"^",11) S Y=$P(^AUTTHF(X,0),"^") K X
Q
;
POV(VISIT,ARRAY) ;
; -- return purpose of visit for a visit pointer
; Input Visit := visit pointer
; Array := call by reference the array to put the POV into
; Output Array
;
N I K ARRAY
I $G(VISIT)<0 G POVQ
S I=0 F S I=$O(^AUPNVPOV("AD",VISIT,I)) Q:'I S ARRAY(I)=^AUPNVPOV(I,0)
POVQ Q
PXAPIIB ;ISA/AAS - SUPPORTED REFERENCES FOR AICS ; 12/11/95
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996
+2 ;
+3 ; -- Output transforms, used for outputting entry during formatting
+4 ; and after scanning before sending to PCE.
+5 ; -- called by the package interface file and IBDFBK3
+6 ;
DSPLYED(IEN) ; -- function, returns .01 field of entry ien
+1 ; -- output transform for Education Topics (file #9999999.09)
+2 ; -- example of use: S Y=$$DSPLYED^PXAPIIB(Y)
+3 QUIT $PIECE($GET(^AUTTEDT(+$GET(IEN),0)),"^")
+4 ;
DSPLYIM(IEN) ; -- function, returns .01 field of entry ien
+1 ; -- output transform for Immunizations (file #9999999.14)
+2 QUIT $PIECE($GET(^AUTTIMM(+$GET(IEN),0)),"^")
+3 ;
DSPLYEX(IEN) ; -- function, returns .01 field of entry ien
+1 ; -- output transform for EXAMS (file #9999999.15)
+2 QUIT $PIECE($GET(^AUTTEXAM(+$GET(IEN),0)),"^")
+3 ;
DSPLYTR(IEN) ; -- function, returns .01 field of entry ien
+1 ; -- output transform for TREATMENTS (file #9999999.17)
+2 QUIT $PIECE($GET(^AUTTTRT(+$GET(IEN),0)),"^")
+3 ;
DSPLYSK(IEN) ; -- function, returns .01 field of entry ien
+1 ; -- output transform for Education Topics (file #9999999.28)
+2 QUIT $PIECE($GET(^AUTTSK(+$GET(IEN),0)),"^")
+3 ;
DSPLYHF(IEN) ; -- function, returns .01 field of entry ien
+1 ; -- output transform for Health Factors (file #9999999.64)
+2 QUIT $PIECE($GET(^AUTTHF(+$GET(IEN),0)),"^")
+3 ;
+4 ;
+5 ; -- Validation routines, used by the utility to validate active
+6 ; entries on a form, called from package interface file.
+7 ;
TESTEDT ; -- does X point to a valid Education Topic? Kills X if not.
+1 ; input X := pointer to 9999999.09
+2 ; output := if valid x=x,y=""
+3 ; := if entry not exist x is killed, y=""
+4 ; := if entry exist but inactive x is killed, y=.01 field
+5 ;
+6 IF '$GET(X)
KILL X
SET Y=""
QUIT
+7 IF '$DATA(^AUTTEDT(X,0))
KILL X
SET Y=""
QUIT
+8 IF $PIECE($GET(^AUTTEDT(X,0)),"^",3)
SET Y=$PIECE(^AUTTEDT(X,0),"^")
KILL X
+9 QUIT
+10 ;
TESTIMM ; -- does X point to a valid Immunization? Kills X if not.
+1 ; input X := pointer to 9999999.14
+2 ; output := if valid x=x,y=""
+3 ; := if entry not exist x is killed, y=""
+4 ; := if entry exist but inactive x is killed, y=.01 field
+5 ;
+6 IF '$GET(X)
KILL X
SET Y=""
QUIT
+7 IF '$DATA(^AUTTIMM(X,0))
KILL X
SET Y=""
QUIT
+8 IF $PIECE($GET(^AUTTIMM(X,0)),"^",7)
SET Y=$PIECE(^AUTTEDT(X,0),"^")
KILL X
+9 QUIT
+10 ;
TESTEXM ; -- does X point to a valid EXAM? Kills X if not.
+1 ; input X := pointer to 9999999.15
+2 ; output := if valid x=x,y=""
+3 ; := if entry not exist x is killed, y=""
+4 ; := if entry exist but inactive x is killed, y=.01 field
+5 ;
+6 IF '$GET(X)
KILL X
SET Y=""
QUIT
+7 IF '$DATA(^AUTTEXAM(X,0))
KILL X
SET Y=""
QUIT
+8 IF $PIECE($GET(^AUTTEXAM(X,0)),"^",4)
SET Y=$PIECE(^AUTTEXAM(X,0),"^")
KILL X
+9 QUIT
+10 ;
TESTTRT ; -- does X point to a valid Treatment? Kills X if not.
+1 ; input X := pointer to 9999999.17
+2 ; output := if valid x=x,y=""
+3 ; := if entry not exist x is killed, y=""
+4 ; := if entry exist but inactive x is killed, y=.01 field
+5 ;
+6 IF '$GET(X)
KILL X
SET Y=""
QUIT
+7 IF '$DATA(^AUTTTRT(X,0))
KILL X
SET Y=""
QUIT
+8 IF $PIECE($GET(^AUTTTRT(X,0)),"^",4)
SET Y=$PIECE(^AUTTTRT(X,0),"^")
KILL X
+9 QUIT
+10 ;
TESTSK ; -- does X point to a valid Skin Test? Kills X if not.
+1 ; input X := pointer to 9999999.28
+2 ; output := if valid x=x,y=""
+3 ; := if entry not exist x is killed, y=""
+4 ; := if entry exist but inactive x is killed, y=.01 field
+5 ;
+6 IF '$GET(X)
KILL X
SET Y=""
QUIT
+7 IF '$DATA(^AUTTSK(X,0))
KILL X
SET Y=""
QUIT
+8 IF $PIECE($GET(^AUTTSK(X,0)),"^",3)
SET Y=$PIECE(^AUTTSK(X,0),"^")
KILL X
+9 QUIT
+10 ;
TESTHF ; -- does X point to a valid Health Factor? Kills X if not.
+1 ; input X := pointer to 9999999.64
+2 ; output := if valid x=x,y=""
+3 ; := if entry not exist x is killed, y=""
+4 ; := if entry exist but inactive x is killed, y=.01 field
+5 ;
+6 IF '$GET(X)
KILL X
SET Y=""
QUIT
+7 IF '$DATA(^AUTTHF(X,0))
KILL X
SET Y=""
QUIT
+8 IF $PIECE($GET(^AUTTHF(X,0)),"^",11)
SET Y=$PIECE(^AUTTHF(X,0),"^")
KILL X
+9 QUIT
+10 ;
POV(VISIT,ARRAY) ;
+1 ; -- return purpose of visit for a visit pointer
+2 ; Input Visit := visit pointer
+3 ; Array := call by reference the array to put the POV into
+4 ; Output Array
+5 ;
+6 NEW I
KILL ARRAY
+7 IF $GET(VISIT)<0
GOTO POVQ
+8 SET I=0
FOR
SET I=$ORDER(^AUPNVPOV("AD",VISIT,I))
IF 'I
QUIT
SET ARRAY(I)=^AUPNVPOV(I,0)
POVQ QUIT
