- 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 ;