APCHPRE ;IHS/CMI/GRL Patient Health Summary - Pre Visit[ 02/11/2005 11:05 PM ]
;;2.0;IHS RPMS/PCC Health Summary;**14**;JUN 24, 1997
;
EN ;
Q ;NOT READY YET
W:$D(IOF) @IOF
W !!,$$CTR("*** Print Patient Medical Handout ***"),!!
K DIC S DIC="^AUPNPAT(",DIC(0)="AEMQ" D ^DIC K DIC
I Y=-1 D EXIT Q
S DFN=+Y
W !
ZIS ;
W ! S DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen",DIR("A")="Do you wish to",DIR("B")="P" K DA D ^DIR K DIR
I $D(DIRUT) D EXIT Q
S APCHOPT=Y
I Y="B" D BROWSE,EXIT Q
S XBRP="PRINT^APCHPRE",XBRC="",XBRX="EXIT^APCHPRE",XBNS="APCH;DFN"
D ^XBDBQUE
D EXIT
Q
BROWSE ;
S XBRP="VIEWR^XBLM(""PRINT^APCHPRE"")"
S XBRC="",XBRX="EXIT^APCHPRE",XBIOP=0 D ^XBDBQUE
Q
EXIT ;
D EN^XBVK("APCH")
D ^XBFMK
Q
S(Y,F,C,T) ;set up array
I '$G(F) S F=0
I '$G(T) S T=0
NEW %,X
;blank lines
F F=1:1:F S X="" D S1
S X=Y
I $G(C) S L=$L(Y),T=(80-L)/2 D D S1 Q
.F %=1:1:(T-1) S X=" "_X
F %=1:1:T S X=" "_Y
D S1
Q
S1 ;
S %=$P(^TMP("APCHPHS",$J,"PHS",0),U)+1,$P(^TMP("APCHPHS",$J,"PHS",0),U)=%
S ^TMP("APCHPHS",$J,"PHS",%)=X
Q
PRINT ;
OUTPUT S APCHSCVD="S:Y]"""" Y=+Y,Y=$E(Y,4,5)_""/""_$S($E(Y,6,7):$E(Y,6,7)_""/"",1:"""")_$E(Y,2,3)"
K ^TMP("APCH",$J)
S APCHSPAT=DFN
D EP^APCHPRE1(DFN) ;gather up data
W ;write out array
W:$D(IOF) @IOF
K APCHQUIT
W !,"********** Patient Medical Handout ********** ["_$P(^VA(200,DUZ,0),U,2)_"] "_$$FMTE^XLFDT(DT)_" **********"
S APCHX=0 F S APCHX=$O(^TMP("APCHPHS",$J,"PHS",APCHX)) Q:APCHX'=+APCHX!($D(APCHQUIT)) D
.I $Y>(IOSL-3) D HEADER Q:$D(APCHQUIT)
.W !,^TMP("APCHPHS",$J,"PHS",APCHX)
.Q
I $D(APCHQUIT) S APCHSQIT=1
D EOJ
Q
;
EOJ ;
K ^TMP("APCHPHS",$J)
K APCHX,APCHQUIT,APCHY,APCHSDFN,APCHSBEG,APCHSTOB,APCHSUPI,APCHSED,APCHTOBN,APCHTOB,APCHSPAT
K APCHLFGV,APCHLFGD,APCHLGLV,APCHLGLD,APCHLFOB,APCHLBE,APCHLCOL,APCHLSIG,APCHSCRN,APCHCOLO
K APCHPNV,APCHPND,APCHMNV,APCHMND,APCHIMMN,APCHIMMT,APCHICTR,APCHI,APCHIMDU,APCHIMM,APCHLDRE
K APCHC,APCHOPT,APCHSCVD
K N,%,T,F,X,Y,B,C,E,F,H,L,N,P,T,W
Q
I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCHQUIT="" Q
HEAD1 ;
W:$D(IOF) @IOF
W !,"********** CONFIDENTIAL PATIENT INFORMATION ["_$P(^VA(200,DUZ,0),U,2)_"] "_$$FMTE^XLFDT(DT)_" **********",!!
Q
CTR(X,Y) ;EP - Center X in a field Y wide.
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;----------
USR() ;EP - Return name of current user from ^VA(200.
Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
;----------
LOC() ;EP - Return location name from file 4 based on DUZ(2).
Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
;----------
;
;
;
SDEP ;entry point from Scheduling Package with DFN defined
Q ;;NOT READY YET
I '$P($G(^APCCCTRL(DUZ(2),0)),U,14) ;set site parameter in PCC Master Control file has to be set
I $$V2(DFN,$$FMTE^XLFDT(DT,-1)) Q ;IF PT HAD A VISIT IN PAST 120 DAYS DON'T BOTHER
I SDAMEVT,$P($G(^SD(409.66,SDAMEVT,0)),U)="CHECK-IN" D
. W !!,"Do you wish to print a Patient Medical Handout to give to the patient?"
. W !,"If so, enter the device to print the handout on, otherwise enter a '^'."
. S XBRP="PRINT^APCHPRE",XBRC="",XBRX="EXIT^APCHPRE",XBNS="APCH;DFN"
. D ^XBDBQUE
Q
;
;
;
V2(P,EDATE) ;
NEW APCHBDAT,A,B,C,G,V,X
S APCHBDAT=$$FMADD^XLFDT(DT,-120)
I '$D(^AUPNVSIT("AC",P)) Q ""
K ^TMP($J,"A")
S A="^TMP($J,""A"",",B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(APCHBDAT)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(B,A)
I '$D(^TMP($J,"A",1)) Q ""
S (X,G)=0 F S X=$O(^TMP($J,"A",X)) Q:X'=+X!(G) S V=$P(^TMP($J,"A",X),U,5) D
.Q:'$D(^AUPNVSIT(V,0))
.Q:'$P(^AUPNVSIT(V,0),U,9)
.Q:$P(^AUPNVSIT(V,0),U,11)
.Q:"A"'[$P(^AUPNVSIT(V,0),U,7)
.Q:$P(^AUPNVSIT(V,0),U,6)'=DUZ(2)
.S T=$O(^ATXAX("B","APCH CLINIC STOP FOR PT HS",0))
.S C=$P(^AUPNVSIT(V,0),U,8)
.Q:$G(C)']""
.Q:$D(^ATXAX(T,21,"B",C))
.S G=G+1
.Q
Q $S(G<1:"",1:1)
;
APCHPRE ;IHS/CMI/GRL Patient Health Summary - Pre Visit[ 02/11/2005 11:05 PM ]
+1 ;;2.0;IHS RPMS/PCC Health Summary;**14**;JUN 24, 1997
+2 ;
EN ;
+1 ;NOT READY YET
QUIT
+2 IF $DATA(IOF)
WRITE @IOF
+3 WRITE !!,$$CTR("*** Print Patient Medical Handout ***"),!!
+4 KILL DIC
SET DIC="^AUPNPAT("
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
+5 IF Y=-1
DO EXIT
QUIT
+6 SET DFN=+Y
+7 WRITE !
ZIS ;
+1 WRITE !
SET DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen"
SET DIR("A")="Do you wish to"
SET DIR("B")="P"
KILL DA
DO ^DIR
KILL DIR
+2 IF $DATA(DIRUT)
DO EXIT
QUIT
+3 SET APCHOPT=Y
+4 IF Y="B"
DO BROWSE
DO EXIT
QUIT
+5 SET XBRP="PRINT^APCHPRE"
SET XBRC=""
SET XBRX="EXIT^APCHPRE"
SET XBNS="APCH;DFN"
+6 DO ^XBDBQUE
+7 DO EXIT
+8 QUIT
BROWSE ;
+1 SET XBRP="VIEWR^XBLM(""PRINT^APCHPRE"")"
+2 SET XBRC=""
SET XBRX="EXIT^APCHPRE"
SET XBIOP=0
DO ^XBDBQUE
+3 QUIT
EXIT ;
+1 DO EN^XBVK("APCH")
+2 DO ^XBFMK
+3 QUIT
S(Y,F,C,T) ;set up array
+1 IF '$GET(F)
SET F=0
+2 IF '$GET(T)
SET T=0
+3 NEW %,X
+4 ;blank lines
+5 FOR F=1:1:F
SET X=""
DO S1
+6 SET X=Y
+7 IF $GET(C)
SET L=$LENGTH(Y)
SET T=(80-L)/2
Begin DoDot:1
+8 FOR %=1:1:(T-1)
SET X=" "_X
End DoDot:1
DO S1
QUIT
+9 FOR %=1:1:T
SET X=" "_Y
+10 DO S1
+11 QUIT
S1 ;
+1 SET %=$PIECE(^TMP("APCHPHS",$JOB,"PHS",0),U)+1
SET $PIECE(^TMP("APCHPHS",$JOB,"PHS",0),U)=%
+2 SET ^TMP("APCHPHS",$JOB,"PHS",%)=X
+3 QUIT
PRINT ;
OUTPUT SET APCHSCVD="S:Y]"""" Y=+Y,Y=$E(Y,4,5)_""/""_$S($E(Y,6,7):$E(Y,6,7)_""/"",1:"""")_$E(Y,2,3)"
+1 KILL ^TMP("APCH",$JOB)
+2 SET APCHSPAT=DFN
+3 ;gather up data
DO EP^APCHPRE1(DFN)
W ;write out array
+1 IF $DATA(IOF)
WRITE @IOF
+2 KILL APCHQUIT
+3 WRITE !,"********** Patient Medical Handout ********** ["_$PIECE(^VA(200,DUZ,0),U,2)_"] "_$$FMTE^XLFDT(DT)_" **********"
+4 SET APCHX=0
FOR
SET APCHX=$ORDER(^TMP("APCHPHS",$JOB,"PHS",APCHX))
IF APCHX'=+APCHX!($DATA(APCHQUIT))
QUIT
Begin DoDot:1
+5 IF $Y>(IOSL-3)
DO HEADER
IF $DATA(APCHQUIT)
QUIT
+6 WRITE !,^TMP("APCHPHS",$JOB,"PHS",APCHX)
+7 QUIT
End DoDot:1
+8 IF $DATA(APCHQUIT)
SET APCHSQIT=1
+9 DO EOJ
+10 QUIT
+11 ;
EOJ ;
+1 KILL ^TMP("APCHPHS",$JOB)
+2 KILL APCHX,APCHQUIT,APCHY,APCHSDFN,APCHSBEG,APCHSTOB,APCHSUPI,APCHSED,APCHTOBN,APCHTOB,APCHSPAT
+3 KILL APCHLFGV,APCHLFGD,APCHLGLV,APCHLGLD,APCHLFOB,APCHLBE,APCHLCOL,APCHLSIG,APCHSCRN,APCHCOLO
+4 KILL APCHPNV,APCHPND,APCHMNV,APCHMND,APCHIMMN,APCHIMMT,APCHICTR,APCHI,APCHIMDU,APCHIMM,APCHLDRE
+5 KILL APCHC,APCHOPT,APCHSCVD
+6 KILL N,%,T,F,X,Y,B,C,E,F,H,L,N,P,T,W
+7 QUIT
+1 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET APCHQUIT=""
QUIT
HEAD1 ;
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,"********** CONFIDENTIAL PATIENT INFORMATION ["_$PIECE(^VA(200,DUZ,0),U,2)_"] "_$$FMTE^XLFDT(DT)_" **********",!!
+3 QUIT
CTR(X,Y) ;EP - Center X in a field Y wide.
+1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
+2 ;----------
USR() ;EP - Return name of current user from ^VA(200.
+1 QUIT $SELECT($GET(DUZ):$SELECT($DATA(^VA(200,DUZ,0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
+2 ;----------
LOC() ;EP - Return location name from file 4 based on DUZ(2).
+1 QUIT $SELECT($GET(DUZ(2)):$SELECT($DATA(^DIC(4,DUZ(2),0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
+2 ;----------
+3 ;
+4 ;
+5 ;
SDEP ;entry point from Scheduling Package with DFN defined
+1 ;;NOT READY YET
QUIT
+2 ;set site parameter in PCC Master Control file has to be set
IF '$PIECE($GET(^APCCCTRL(DUZ(2),0)),U,14)
+3 ;IF PT HAD A VISIT IN PAST 120 DAYS DON'T BOTHER
IF $$V2(DFN,$$FMTE^XLFDT(DT,-1))
QUIT
+4 IF SDAMEVT
IF $PIECE($GET(^SD(409.66,SDAMEVT,0)),U)="CHECK-IN"
Begin DoDot:1
+5 WRITE !!,"Do you wish to print a Patient Medical Handout to give to the patient?"
+6 WRITE !,"If so, enter the device to print the handout on, otherwise enter a '^'."
+7 SET XBRP="PRINT^APCHPRE"
SET XBRC=""
SET XBRX="EXIT^APCHPRE"
SET XBNS="APCH;DFN"
+8 DO ^XBDBQUE
End DoDot:1
+9 QUIT
+10 ;
+11 ;
+12 ;
V2(P,EDATE) ;
+1 NEW APCHBDAT,A,B,C,G,V,X
+2 SET APCHBDAT=$$FMADD^XLFDT(DT,-120)
+3 IF '$DATA(^AUPNVSIT("AC",P))
QUIT ""
+4 KILL ^TMP($JOB,"A")
+5 SET A="^TMP($J,""A"","
SET B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(APCHBDAT)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(B,A)
+6 IF '$DATA(^TMP($JOB,"A",1))
QUIT ""
+7 SET (X,G)=0
FOR
SET X=$ORDER(^TMP($JOB,"A",X))
IF X'=+X!(G)
QUIT
SET V=$PIECE(^TMP($JOB,"A",X),U,5)
Begin DoDot:1
+8 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+9 IF '$PIECE(^AUPNVSIT(V,0),U,9)
QUIT
+10 IF $PIECE(^AUPNVSIT(V,0),U,11)
QUIT
+11 IF "A"'[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+12 IF $PIECE(^AUPNVSIT(V,0),U,6)'=DUZ(2)
QUIT
+13 SET T=$ORDER(^ATXAX("B","APCH CLINIC STOP FOR PT HS",0))
+14 SET C=$PIECE(^AUPNVSIT(V,0),U,8)
+15 IF $GET(C)']""
QUIT
+16 IF $DATA(^ATXAX(T,21,"B",C))
QUIT
+17 SET G=G+1
+18 QUIT
End DoDot:1
+19 QUIT $SELECT(G<1:"",1:1)
+20 ;
