APCDDMU3 ; IHS/CMI/LAB - prompt for refusal value ; 27 Jan 2011 2:41 PM
;;2.0;IHS PCC SUITE;**5,7**;MAY 14, 2009
;
;
FLU(Y) ;EP
I $G(Y)="" Q 0
I '$D(^AUTTIMM(Y,0)) Q 0
;I $P(^AUTTIMM(Y,0),U,7)=1 Q 0
I $P(^AUTTIMM(Y,0),U,3)=88 Q 1
I $P(^AUTTIMM(Y,0),U,3)=16 Q 1
I $P(^AUTTIMM(Y,0),U,3)=15 Q 1
I $P(^AUTTIMM(Y,0),U,3)=111 Q 1
I $P(^AUTTIMM(Y,0),U,3)=135 Q 1
I $P(^AUTTIMM(Y,0),U,3)=140 Q 1
I $P(^AUTTIMM(Y,0),U,3)=141 Q 1
I $P(^AUTTIMM(Y,0),U,3)=144 Q 1
Q 0
PN(Y) ;EP
I $G(Y)="" Q 0
I '$D(^AUTTIMM(Y,0)) Q 0
;I $P(^AUTTIMM(Y,0),U,7)=1 Q 0
N Z
S Z=$P(^AUTTIMM(Y,0),U,3)
I Z=33 Q 1
I Z=100 Q 1
I Z=109 Q 1
Q 0
TD(Y) ;EP
I $G(Y)="" Q 0
I '$D(^AUTTIMM(Y,0)) Q 0
;I $P(^AUTTIMM(Y,0),U,7)=1 Q 0
N Z
S Z=$P(^AUTTIMM(Y,0),U,3)
I Z=1 Q 1
I Z=9 Q 1
I Z=20 Q 1
I Z=22 Q 1
I Z=28 Q 1
I Z=35 Q 1
I Z=50 Q 1
I Z=106 Q 1
I Z=107 Q 1
I Z=110 Q 1
I Z=113 Q 1
I Z=115 Q 1
I Z=120 Q 1
I Z=130 Q 1
I Z=132 Q 1
I Z=138 Q 1
I Z=139 Q 1
I Z=142 Q 1
Q 0
REF ;EP
K APCDX,APCDTF,APCDTERR,APCDTOLD,APCDTID,APCDTIEN,APCDRDN,APCDTREA
D ^XBFMK K DIADD,DLAYGO
S DIR(0)="9000022,.03",DIR("A")="Enter Date of Refusals/Declined Service" KILL DA D ^DIR KILL DIR
I $D(DIRUT) D EOJ Q
S APCDDRN=Y
S DIC="^AUTTREFT(",DIC(0)="AEMQ",DIC("A")="Enter Service Type: " D ^DIC K DIC
I Y=-1 W !,"exiting......." Q
S APCDX=+Y
VALUE ;EP - called from input template
S APCDTF=$P(^AUTTREFT(APCDX,0),U,2)
I 'APCDTF S APCDTERR=1 D EOJ Q
S DIC("B")=$S($D(APCDTOLD):APCDTOLD,1:""),DIC("A")="Enter the "_$P(^DIC(APCDTF,0),U)_" value: ",DIC=APCDTF,DIC(0)="AEMQ" D ^DIC K DIC
I Y=-1 W !!,"Invalid entry. Try again." G REF
S APCDTIEN=+Y,APCDTID=$$VAL^XBDIQ1(APCDTF,APCDTIEN,$P(^AUTTREFT(APCDX,0),U,3))
S DIR(0)="9000022,.07",DIR("A")="Enter Reason not Done" KILL DA D ^DIR KILL DIR
I $D(DIRUT) W !,"Reason is Required" G REF
I Y="" W !,"Reason is Required" G REF
S APCDTREA=Y
W !,"creating Refusal entry in PCC..."
K DIC,DLAYGO,DIADD
S DIC(0)="L",DIC="^AUPNPREF(",X=APCDX,DIC("DR")=".02////"_APCDDMPT_";.03////"_APCDDRN_";.04////"_APCDTID_";.05////"_APCDTF_";.06////"_APCDTIEN_";.07////"_APCDTREA K DD,D0 D FILE^DICN
I Y=-1 W !!,"Creating refusal entry failed...." H 2 D ^XBFMK G REF
D ^XBFMK
K DIADD,DLAYGO
W !! S DIR(0)="Y",DIR("A")="Would you like to enter another Service not done",DIR("B")="N" KILL DA D ^DIR KILL DIR
I $D(DIRUT) D EOJ Q
I 'Y D EOJ Q
G REF
EOJ ;
K APCDX,APCDTF,APCDTERR,APCDTOLD,APCDTID,APCDTIEN
D ^XBFMK
K Y
Q
BTL(A) ;EP - called from screen on BARRIERS TO LEARN
I '$D(^AUTTHF(A,0)) Q 0
I $P(^AUTTHF(A,0),U,10)'="F" Q 0
I $P(^AUTTHF(A,0),U,13) Q 0
NEW B S B=$O(^AUTTHF("B","BARRIERS TO LEARNING",0)) I 'B Q 0
I $P(^AUTTHF(A,0),U,3)'=B Q 0
Q 1
;
RTL(A) ;EP - called from dd
I '$D(^AUTTHF(A,0)) Q 0
I $P(^AUTTHF(A,0),U,10)'="F" Q 0
I $P(^AUTTHF(A,0),U,13) Q 0
NEW B S B=$O(^AUTTHF("B","READINESS TO LEARN",0)) I 'B Q 0
I $P(^AUTTHF(A,0),U,3)'=B Q 0
Q 1
;
LP(A) ;EP - called from screen on LEARNING PREFERENCE
I '$D(^AUTTHF(A,0)) Q 0
I $P(^AUTTHF(A,0),U,10)'="F" Q 0
I $P(^AUTTHF(A,0),U,13) Q 0
NEW B S B=$O(^AUTTHF("B","LEARNING PREFERENCE",0)) I 'B Q 0
I $P(^AUTTHF(A,0),U,3)'=B Q 0
Q 1
BTLHF ;EP
K APCDVSIT
I $P($G(^APCDDMUP(APCDDA,11)),U,8)="" Q
S APCDDMDT=$S($P(APCDREC1,U,17)]"":$P(APCDREC1,U,17),1:DT)
S APCDMTYP=$P(^APCDDMUP(APCDDA,11),U,8)
S APCDMCAT=$P(^AUTTHF(APCDMTYP,0),U,3)
D EVSIT^APCDDMUP ;get event visit
I '$G(APCDVSIT) S T="Could not Create PCC Visit when attempting to update Barriers to Learning health factor." D ERR^APCDDMUP(T) Q
S (X,G)=0 F S X=$O(^AUPNVHF("AD",APCDVSIT,X)) Q:X'=+X!(G) I $P(^AUPNVHF(X,0),U)=APCDMTYP S G=1
I G S T="Already have a health factor of "_$P(^AUTTHF($P(^APCDDMUP(APCDDA,11),U,8),0),U)_" on Visit Date "_$$FMTE^XLFDT($P(^AUPNVSIT(APCDVSIT,0),U)) D ERR^APCDDMUP(T) Q
K APCDALVR
S APCDALVR("APCDPAT")=APCDDMPT
S APCDALVR("APCDVSIT")=APCDVSIT
S APCDALVR("APCDATMP")="[APCDALVR 9000010.23 (ADD)]"
S APCDALVR("APCDTHF")="`"_APCDMTYP
D ^APCDALVR
I $D(APCDALVR("APCDAFLG")) S T="Error creating V Health Factor Entry for Barriers to Learning. PCC not updated." D ERR^APCDDMUP(T)
K APCDALVR
;update health status
;S APCDHSE="",X=0 F S X=$O(^AUPNHF("AC",APCDDMPT,X)) Q:X'=+X!(APCDHSE) I $P(^AUTTHF($P(^AUPNHF(X,0),U),0),U,3)=APCDMCAT S APCDHSE=X
;I APCDHSE D Q
;.D ^XBFMK K DIADD
;.S DA=APCDHSE,DIE="^AUPNHF(",DR=".01///`"_APCDMTYP_";.03////"_DT D ^DIE
;.I $D(Y) S T="Error updating Health Status entry for Barriers to Learning." D ERR^APCDDMUP(T)
;.D ^XBFMK
;D ^XBFMK
;S X=APCDMTYP,DIC("DR")=".02////"_APCDDMPT_";.03////"_DT,DIC(0)="L",DIADD=1,DLAYGO=9000019,DIC="^AUPNHF(" D FILE^DICN
;I Y=-1 S T="Error adding health status entry for Barriers to Learning." D ERR^APCDDMUP(T)
D ^XBFMK K DIADD,DLAYGO
Q
RTLHF ;EP
K APCDVSIT
I $P($G(^APCDDMUP(APCDDA,11)),U,9)="" Q
S APCDDMDT=$S($P(APCDREC1,U,18)]"":$P(APCDREC1,U,18),1:DT)
S APCDMTYP=$P(^APCDDMUP(APCDDA,11),U,9)
S APCDMCAT=$P(^AUTTHF(APCDMTYP,0),U,3)
D EVSIT^APCDDMUP ;get event visit
I '$G(APCDVSIT) S T="Could not Create PCC Visit when attempting to update READINESS TO LEARN health factor." D ERR^APCDDMUP(T) Q
S (X,G)=0 F S X=$O(^AUPNVHF("AD",APCDVSIT,X)) Q:X'=+X!(G) I $P(^AUPNVHF(X,0),U)=APCDMTYP S G=1
I G S T="Already have a health factor of "_$P(^AUTTHF($P(^APCDDMUP(APCDDA,11),U,9),0),U)_" on Visit Date "_$$FMTE^XLFDT($P(^AUPNVSIT(APCDVSIT,0),U)) D ERR^APCDDMUP(T) Q
K APCDALVR
S APCDALVR("APCDPAT")=APCDDMPT
S APCDALVR("APCDVSIT")=APCDVSIT
S APCDALVR("APCDATMP")="[APCDALVR 9000010.23 (ADD)]"
S APCDALVR("APCDTHF")="`"_APCDMTYP
D ^APCDALVR
I $D(APCDALVR("APCDAFLG")) S T="Error creating V Health Factor Entry for READINESS TO LEARN. PCC not updated." D ERR^APCDDMUP(T)
K APCDALVR
;S APCDHSE="",X=0 F S X=$O(^AUPNHF("AC",APCDDMPT,X)) Q:X'=+X!(APCDHSE) I $P(^AUTTHF($P(^AUPNHF(X,0),U),0),U,3)=APCDMCAT S APCDHSE=X
;I APCDHSE D Q
;.D ^XBFMK K DIADD
;.S DA=APCDHSE,DIE="^AUPNHF(",DR=".01///`"_APCDMTYP_";.03////"_DT D ^DIE
;.I $D(Y) S T="Error updating Health Status entry for READINESS TO LEARN." D ERR^APCDDMUP(T)
;.D ^XBFMK
;D ^XBFMK
;S X=APCDMTYP,DIC("DR")=".02////"_APCDDMPT_";.03////"_DT,DIC(0)="L",DIADD=1,DLAYGO=9000019,DIC="^AUPNHF(" D FILE^DICN
;I Y=-1 S T="Error adding health status entry for READINESS TO LEARN." D ERR^APCDDMUP(T)
D ^XBFMK K DIADD,DLAYGO
Q
;
LPHF ;EP
K APCDVSIT
I $P($G(^APCDDMUP(APCDDA,11)),U,10)="" Q
S APCDDMDT=$S($P(APCDREC1,U,19)]"":$P(APCDREC1,U,19),1:DT)
S APCDMTYP=$P(^APCDDMUP(APCDDA,11),U,10)
S APCDMCAT=$P(^AUTTHF(APCDMTYP,0),U,3)
D EVSIT^APCDDMUP ;get event visit
I '$G(APCDVSIT) S T="Could not Create PCC Visit when attempting to update LEARNING PREFERENCE health factor." D ERR^APCDDMUP(T) Q
S (X,G)=0 F S X=$O(^AUPNVHF("AD",APCDVSIT,X)) Q:X'=+X!(G) I $P(^AUPNVHF(X,0),U)=APCDMTYP S G=1
I G S T="Already have a health factor of "_$P(^AUTTHF($P(^APCDDMUP(APCDDA,11),U,10),0),U)_" on Visit Date "_$$FMTE^XLFDT($P(^AUPNVSIT(APCDVSIT,0),U)) D ERR^APCDDMUP(T) Q
K APCDALVR
S APCDALVR("APCDPAT")=APCDDMPT
S APCDALVR("APCDVSIT")=APCDVSIT
S APCDALVR("APCDATMP")="[APCDALVR 9000010.23 (ADD)]"
S APCDALVR("APCDTHF")="`"_APCDMTYP
D ^APCDALVR
I $D(APCDALVR("APCDAFLG")) S T="Error creating V Health Factor Entry for LEARNING PREFERENCE. PCC not updated." D ERR^APCDDMUP(T)
K APCDALVR
;S APCDHSE="",X=0 F S X=$O(^AUPNHF("AC",APCDDMPT,X)) Q:X'=+X!(APCDHSE) I $P(^AUTTHF($P(^AUPNHF(X,0),U),0),U,3)=APCDMCAT S APCDHSE=X
;I APCDHSE D Q
;.D ^XBFMK K DIADD
;.S DA=APCDHSE,DIE="^AUPNHF(",DR=".01///`"_APCDMTYP_";.03////"_DT D ^DIE
;.I $D(Y) S T="Error updating Health Status entry for LEARNING PREFERENCE." D ERR^APCDDMUP(T)
;.D ^XBFMK
;D ^XBFMK
;S X=APCDMTYP,DIC("DR")=".02////"_APCDDMPT_";.03////"_DT,DIC(0)="L",DIADD=1,DLAYGO=9000019,DIC="^AUPNHF(" D FILE^DICN
;I Y=-1 S T="Error adding health status entry for LEARNING PREFERENCE." D ERR^APCDDMUP(T)
D ^XBFMK K DIADD,DLAYGO
Q
;
APCDDMU3 ; IHS/CMI/LAB - prompt for refusal value ; 27 Jan 2011 2:41 PM
+1 ;;2.0;IHS PCC SUITE;**5,7**;MAY 14, 2009
+2 ;
+3 ;
FLU(Y) ;EP
+1 IF $GET(Y)=""
QUIT 0
+2 IF '$DATA(^AUTTIMM(Y,0))
QUIT 0
+3 ;I $P(^AUTTIMM(Y,0),U,7)=1 Q 0
+4 IF $PIECE(^AUTTIMM(Y,0),U,3)=88
QUIT 1
+5 IF $PIECE(^AUTTIMM(Y,0),U,3)=16
QUIT 1
+6 IF $PIECE(^AUTTIMM(Y,0),U,3)=15
QUIT 1
+7 IF $PIECE(^AUTTIMM(Y,0),U,3)=111
QUIT 1
+8 IF $PIECE(^AUTTIMM(Y,0),U,3)=135
QUIT 1
+9 IF $PIECE(^AUTTIMM(Y,0),U,3)=140
QUIT 1
+10 IF $PIECE(^AUTTIMM(Y,0),U,3)=141
QUIT 1
+11 IF $PIECE(^AUTTIMM(Y,0),U,3)=144
QUIT 1
+12 QUIT 0
PN(Y) ;EP
+1 IF $GET(Y)=""
QUIT 0
+2 IF '$DATA(^AUTTIMM(Y,0))
QUIT 0
+3 ;I $P(^AUTTIMM(Y,0),U,7)=1 Q 0
+4 NEW Z
+5 SET Z=$PIECE(^AUTTIMM(Y,0),U,3)
+6 IF Z=33
QUIT 1
+7 IF Z=100
QUIT 1
+8 IF Z=109
QUIT 1
+9 QUIT 0
TD(Y) ;EP
+1 IF $GET(Y)=""
QUIT 0
+2 IF '$DATA(^AUTTIMM(Y,0))
QUIT 0
+3 ;I $P(^AUTTIMM(Y,0),U,7)=1 Q 0
+4 NEW Z
+5 SET Z=$PIECE(^AUTTIMM(Y,0),U,3)
+6 IF Z=1
QUIT 1
+7 IF Z=9
QUIT 1
+8 IF Z=20
QUIT 1
+9 IF Z=22
QUIT 1
+10 IF Z=28
QUIT 1
+11 IF Z=35
QUIT 1
+12 IF Z=50
QUIT 1
+13 IF Z=106
QUIT 1
+14 IF Z=107
QUIT 1
+15 IF Z=110
QUIT 1
+16 IF Z=113
QUIT 1
+17 IF Z=115
QUIT 1
+18 IF Z=120
QUIT 1
+19 IF Z=130
QUIT 1
+20 IF Z=132
QUIT 1
+21 IF Z=138
QUIT 1
+22 IF Z=139
QUIT 1
+23 IF Z=142
QUIT 1
+24 QUIT 0
REF ;EP
+1 KILL APCDX,APCDTF,APCDTERR,APCDTOLD,APCDTID,APCDTIEN,APCDRDN,APCDTREA
+2 DO ^XBFMK
KILL DIADD,DLAYGO
+3 SET DIR(0)="9000022,.03"
SET DIR("A")="Enter Date of Refusals/Declined Service"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
DO EOJ
QUIT
+5 SET APCDDRN=Y
+6 SET DIC="^AUTTREFT("
SET DIC(0)="AEMQ"
SET DIC("A")="Enter Service Type: "
DO ^DIC
KILL DIC
+7 IF Y=-1
WRITE !,"exiting......."
QUIT
+8 SET APCDX=+Y
VALUE ;EP - called from input template
+1 SET APCDTF=$PIECE(^AUTTREFT(APCDX,0),U,2)
+2 IF 'APCDTF
SET APCDTERR=1
DO EOJ
QUIT
+3 SET DIC("B")=$SELECT($DATA(APCDTOLD):APCDTOLD,1:"")
SET DIC("A")="Enter the "_$PIECE(^DIC(APCDTF,0),U)_" value: "
SET DIC=APCDTF
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
+4 IF Y=-1
WRITE !!,"Invalid entry. Try again."
GOTO REF
+5 SET APCDTIEN=+Y
SET APCDTID=$$VAL^XBDIQ1(APCDTF,APCDTIEN,$PIECE(^AUTTREFT(APCDX,0),U,3))
+6 SET DIR(0)="9000022,.07"
SET DIR("A")="Enter Reason not Done"
KILL DA
DO ^DIR
KILL DIR
+7 IF $DATA(DIRUT)
WRITE !,"Reason is Required"
GOTO REF
+8 IF Y=""
WRITE !,"Reason is Required"
GOTO REF
+9 SET APCDTREA=Y
+10 WRITE !,"creating Refusal entry in PCC..."
+11 KILL DIC,DLAYGO,DIADD
+12 SET DIC(0)="L"
SET DIC="^AUPNPREF("
SET X=APCDX
SET DIC("DR")=".02////"_APCDDMPT_";.03////"_APCDDRN_";.04////"_APCDTID_";.05////"_APCDTF_";.06////"_APCDTIEN_";.07////"_APCDTREA
KILL DD,D0
DO FILE^DICN
+13 IF Y=-1
WRITE !!,"Creating refusal entry failed...."
HANG 2
DO ^XBFMK
GOTO REF
+14 DO ^XBFMK
+15 KILL DIADD,DLAYGO
+16 WRITE !!
SET DIR(0)="Y"
SET DIR("A")="Would you like to enter another Service not done"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+17 IF $DATA(DIRUT)
DO EOJ
QUIT
+18 IF 'Y
DO EOJ
QUIT
+19 GOTO REF
EOJ ;
+1 KILL APCDX,APCDTF,APCDTERR,APCDTOLD,APCDTID,APCDTIEN
+2 DO ^XBFMK
+3 KILL Y
+4 QUIT
BTL(A) ;EP - called from screen on BARRIERS TO LEARN
+1 IF '$DATA(^AUTTHF(A,0))
QUIT 0
+2 IF $PIECE(^AUTTHF(A,0),U,10)'="F"
QUIT 0
+3 IF $PIECE(^AUTTHF(A,0),U,13)
QUIT 0
+4 NEW B
SET B=$ORDER(^AUTTHF("B","BARRIERS TO LEARNING",0))
IF 'B
QUIT 0
+5 IF $PIECE(^AUTTHF(A,0),U,3)'=B
QUIT 0
+6 QUIT 1
+7 ;
RTL(A) ;EP - called from dd
+1 IF '$DATA(^AUTTHF(A,0))
QUIT 0
+2 IF $PIECE(^AUTTHF(A,0),U,10)'="F"
QUIT 0
+3 IF $PIECE(^AUTTHF(A,0),U,13)
QUIT 0
+4 NEW B
SET B=$ORDER(^AUTTHF("B","READINESS TO LEARN",0))
IF 'B
QUIT 0
+5 IF $PIECE(^AUTTHF(A,0),U,3)'=B
QUIT 0
+6 QUIT 1
+7 ;
LP(A) ;EP - called from screen on LEARNING PREFERENCE
+1 IF '$DATA(^AUTTHF(A,0))
QUIT 0
+2 IF $PIECE(^AUTTHF(A,0),U,10)'="F"
QUIT 0
+3 IF $PIECE(^AUTTHF(A,0),U,13)
QUIT 0
+4 NEW B
SET B=$ORDER(^AUTTHF("B","LEARNING PREFERENCE",0))
IF 'B
QUIT 0
+5 IF $PIECE(^AUTTHF(A,0),U,3)'=B
QUIT 0
+6 QUIT 1
BTLHF ;EP
+1 KILL APCDVSIT
+2 IF $PIECE($GET(^APCDDMUP(APCDDA,11)),U,8)=""
QUIT
+3 SET APCDDMDT=$SELECT($PIECE(APCDREC1,U,17)]"":$PIECE(APCDREC1,U,17),1:DT)
+4 SET APCDMTYP=$PIECE(^APCDDMUP(APCDDA,11),U,8)
+5 SET APCDMCAT=$PIECE(^AUTTHF(APCDMTYP,0),U,3)
+6 ;get event visit
DO EVSIT^APCDDMUP
+7 IF '$GET(APCDVSIT)
SET T="Could not Create PCC Visit when attempting to update Barriers to Learning health factor."
DO ERR^APCDDMUP(T)
QUIT
+8 SET (X,G)=0
FOR
SET X=$ORDER(^AUPNVHF("AD",APCDVSIT,X))
IF X'=+X!(G)
QUIT
IF $PIECE(^AUPNVHF(X,0),U)=APCDMTYP
SET G=1
+9 IF G
SET T="Already have a health factor of "_$PIECE(^AUTTHF($PIECE(^APCDDMUP(APCDDA,11),U,8),0),U)_" on Visit Date "_$$FMTE^XLFDT($PIECE(^AUPNVSIT(APCDVSIT,0),U))
DO ERR^APCDDMUP(T)
QUIT
+10 KILL APCDALVR
+11 SET APCDALVR("APCDPAT")=APCDDMPT
+12 SET APCDALVR("APCDVSIT")=APCDVSIT
+13 SET APCDALVR("APCDATMP")="[APCDALVR 9000010.23 (ADD)]"
+14 SET APCDALVR("APCDTHF")="`"_APCDMTYP
+15 DO ^APCDALVR
+16 IF $DATA(APCDALVR("APCDAFLG"))
SET T="Error creating V Health Factor Entry for Barriers to Learning. PCC not updated."
DO ERR^APCDDMUP(T)
+17 KILL APCDALVR
+18 ;update health status
+19 ;S APCDHSE="",X=0 F S X=$O(^AUPNHF("AC",APCDDMPT,X)) Q:X'=+X!(APCDHSE) I $P(^AUTTHF($P(^AUPNHF(X,0),U),0),U,3)=APCDMCAT S APCDHSE=X
+20 ;I APCDHSE D Q
+21 ;.D ^XBFMK K DIADD
+22 ;.S DA=APCDHSE,DIE="^AUPNHF(",DR=".01///`"_APCDMTYP_";.03////"_DT D ^DIE
+23 ;.I $D(Y) S T="Error updating Health Status entry for Barriers to Learning." D ERR^APCDDMUP(T)
+24 ;.D ^XBFMK
+25 ;D ^XBFMK
+26 ;S X=APCDMTYP,DIC("DR")=".02////"_APCDDMPT_";.03////"_DT,DIC(0)="L",DIADD=1,DLAYGO=9000019,DIC="^AUPNHF(" D FILE^DICN
+27 ;I Y=-1 S T="Error adding health status entry for Barriers to Learning." D ERR^APCDDMUP(T)
+28 DO ^XBFMK
KILL DIADD,DLAYGO
+29 QUIT
RTLHF ;EP
+1 KILL APCDVSIT
+2 IF $PIECE($GET(^APCDDMUP(APCDDA,11)),U,9)=""
QUIT
+3 SET APCDDMDT=$SELECT($PIECE(APCDREC1,U,18)]"":$PIECE(APCDREC1,U,18),1:DT)
+4 SET APCDMTYP=$PIECE(^APCDDMUP(APCDDA,11),U,9)
+5 SET APCDMCAT=$PIECE(^AUTTHF(APCDMTYP,0),U,3)
+6 ;get event visit
DO EVSIT^APCDDMUP
+7 IF '$GET(APCDVSIT)
SET T="Could not Create PCC Visit when attempting to update READINESS TO LEARN health factor."
DO ERR^APCDDMUP(T)
QUIT
+8 SET (X,G)=0
FOR
SET X=$ORDER(^AUPNVHF("AD",APCDVSIT,X))
IF X'=+X!(G)
QUIT
IF $PIECE(^AUPNVHF(X,0),U)=APCDMTYP
SET G=1
+9 IF G
SET T="Already have a health factor of "_$PIECE(^AUTTHF($PIECE(^APCDDMUP(APCDDA,11),U,9),0),U)_" on Visit Date "_$$FMTE^XLFDT($PIECE(^AUPNVSIT(APCDVSIT,0),U))
DO ERR^APCDDMUP(T)
QUIT
+10 KILL APCDALVR
+11 SET APCDALVR("APCDPAT")=APCDDMPT
+12 SET APCDALVR("APCDVSIT")=APCDVSIT
+13 SET APCDALVR("APCDATMP")="[APCDALVR 9000010.23 (ADD)]"
+14 SET APCDALVR("APCDTHF")="`"_APCDMTYP
+15 DO ^APCDALVR
+16 IF $DATA(APCDALVR("APCDAFLG"))
SET T="Error creating V Health Factor Entry for READINESS TO LEARN. PCC not updated."
DO ERR^APCDDMUP(T)
+17 KILL APCDALVR
+18 ;S APCDHSE="",X=0 F S X=$O(^AUPNHF("AC",APCDDMPT,X)) Q:X'=+X!(APCDHSE) I $P(^AUTTHF($P(^AUPNHF(X,0),U),0),U,3)=APCDMCAT S APCDHSE=X
+19 ;I APCDHSE D Q
+20 ;.D ^XBFMK K DIADD
+21 ;.S DA=APCDHSE,DIE="^AUPNHF(",DR=".01///`"_APCDMTYP_";.03////"_DT D ^DIE
+22 ;.I $D(Y) S T="Error updating Health Status entry for READINESS TO LEARN." D ERR^APCDDMUP(T)
+23 ;.D ^XBFMK
+24 ;D ^XBFMK
+25 ;S X=APCDMTYP,DIC("DR")=".02////"_APCDDMPT_";.03////"_DT,DIC(0)="L",DIADD=1,DLAYGO=9000019,DIC="^AUPNHF(" D FILE^DICN
+26 ;I Y=-1 S T="Error adding health status entry for READINESS TO LEARN." D ERR^APCDDMUP(T)
+27 DO ^XBFMK
KILL DIADD,DLAYGO
+28 QUIT
+29 ;
LPHF ;EP
+1 KILL APCDVSIT
+2 IF $PIECE($GET(^APCDDMUP(APCDDA,11)),U,10)=""
QUIT
+3 SET APCDDMDT=$SELECT($PIECE(APCDREC1,U,19)]"":$PIECE(APCDREC1,U,19),1:DT)
+4 SET APCDMTYP=$PIECE(^APCDDMUP(APCDDA,11),U,10)
+5 SET APCDMCAT=$PIECE(^AUTTHF(APCDMTYP,0),U,3)
+6 ;get event visit
DO EVSIT^APCDDMUP
+7 IF '$GET(APCDVSIT)
SET T="Could not Create PCC Visit when attempting to update LEARNING PREFERENCE health factor."
DO ERR^APCDDMUP(T)
QUIT
+8 SET (X,G)=0
FOR
SET X=$ORDER(^AUPNVHF("AD",APCDVSIT,X))
IF X'=+X!(G)
QUIT
IF $PIECE(^AUPNVHF(X,0),U)=APCDMTYP
SET G=1
+9 IF G
SET T="Already have a health factor of "_$PIECE(^AUTTHF($PIECE(^APCDDMUP(APCDDA,11),U,10),0),U)_" on Visit Date "_$$FMTE^XLFDT($PIECE(^AUPNVSIT(APCDVSIT,0),U))
DO ERR^APCDDMUP(T)
QUIT
+10 KILL APCDALVR
+11 SET APCDALVR("APCDPAT")=APCDDMPT
+12 SET APCDALVR("APCDVSIT")=APCDVSIT
+13 SET APCDALVR("APCDATMP")="[APCDALVR 9000010.23 (ADD)]"
+14 SET APCDALVR("APCDTHF")="`"_APCDMTYP
+15 DO ^APCDALVR
+16 IF $DATA(APCDALVR("APCDAFLG"))
SET T="Error creating V Health Factor Entry for LEARNING PREFERENCE. PCC not updated."
DO ERR^APCDDMUP(T)
+17 KILL APCDALVR
+18 ;S APCDHSE="",X=0 F S X=$O(^AUPNHF("AC",APCDDMPT,X)) Q:X'=+X!(APCDHSE) I $P(^AUTTHF($P(^AUPNHF(X,0),U),0),U,3)=APCDMCAT S APCDHSE=X
+19 ;I APCDHSE D Q
+20 ;.D ^XBFMK K DIADD
+21 ;.S DA=APCDHSE,DIE="^AUPNHF(",DR=".01///`"_APCDMTYP_";.03////"_DT D ^DIE
+22 ;.I $D(Y) S T="Error updating Health Status entry for LEARNING PREFERENCE." D ERR^APCDDMUP(T)
+23 ;.D ^XBFMK
+24 ;D ^XBFMK
+25 ;S X=APCDMTYP,DIC("DR")=".02////"_APCDDMPT_";.03////"_DT,DIC(0)="L",DIADD=1,DLAYGO=9000019,DIC="^AUPNHF(" D FILE^DICN
+26 ;I Y=-1 S T="Error adding health status entry for LEARNING PREFERENCE." D ERR^APCDDMUP(T)
+27 DO ^XBFMK
KILL DIADD,DLAYGO
+28 QUIT
+29 ;
