- PXAPIIB ;ISA/AAS - SUPPORTED REFERENCES FOR AICS ; 1/5/07 4:59pm ; Compiled January 18, 2007 10:03:16
- ;;1.0;PCE PATIENT CARE ENCOUNTER;**183**;Aug 12, 1996;Build 3
- ;
- ; -- 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(^AUTTIMM(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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXAPIIB 4334 printed Feb 18, 2025@23:52:31 Page 2
- PXAPIIB ;ISA/AAS - SUPPORTED REFERENCES FOR AICS ; 1/5/07 4:59pm ; Compiled January 18, 2007 10:03:16
- +1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**183**;Aug 12, 1996;Build 3
- +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(^AUTTIMM(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