Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: APCDDMU3

APCDDMU3.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;
  1. FLU(Y) ;EP
  1. I $G(Y)="" Q 0
  1. I '$D(^AUTTIMM(Y,0)) Q 0
  1. ;I $P(^AUTTIMM(Y,0),U,7)=1 Q 0
  1. I $P(^AUTTIMM(Y,0),U,3)=88 Q 1
  1. I $P(^AUTTIMM(Y,0),U,3)=16 Q 1
  1. I $P(^AUTTIMM(Y,0),U,3)=15 Q 1
  1. I $P(^AUTTIMM(Y,0),U,3)=111 Q 1
  1. I $P(^AUTTIMM(Y,0),U,3)=135 Q 1
  1. I $P(^AUTTIMM(Y,0),U,3)=140 Q 1
  1. I $P(^AUTTIMM(Y,0),U,3)=141 Q 1
  1. I $P(^AUTTIMM(Y,0),U,3)=144 Q 1
  1. Q 0
  1. PN(Y) ;EP
  1. I $G(Y)="" Q 0
  1. I '$D(^AUTTIMM(Y,0)) Q 0
  1. ;I $P(^AUTTIMM(Y,0),U,7)=1 Q 0
  1. N Z
  1. S Z=$P(^AUTTIMM(Y,0),U,3)
  1. I Z=33 Q 1
  1. I Z=100 Q 1
  1. I Z=109 Q 1
  1. Q 0
  1. TD(Y) ;EP
  1. I $G(Y)="" Q 0
  1. I '$D(^AUTTIMM(Y,0)) Q 0
  1. ;I $P(^AUTTIMM(Y,0),U,7)=1 Q 0
  1. N Z
  1. S Z=$P(^AUTTIMM(Y,0),U,3)
  1. I Z=1 Q 1
  1. I Z=9 Q 1
  1. I Z=20 Q 1
  1. I Z=22 Q 1
  1. I Z=28 Q 1
  1. I Z=35 Q 1
  1. I Z=50 Q 1
  1. I Z=106 Q 1
  1. I Z=107 Q 1
  1. I Z=110 Q 1
  1. I Z=113 Q 1
  1. I Z=115 Q 1
  1. I Z=120 Q 1
  1. I Z=130 Q 1
  1. I Z=132 Q 1
  1. I Z=138 Q 1
  1. I Z=139 Q 1
  1. I Z=142 Q 1
  1. Q 0
  1. REF ;EP
  1. K APCDX,APCDTF,APCDTERR,APCDTOLD,APCDTID,APCDTIEN,APCDRDN,APCDTREA
  1. D ^XBFMK K DIADD,DLAYGO
  1. S DIR(0)="9000022,.03",DIR("A")="Enter Date of Refusals/Declined Service" KILL DA D ^DIR KILL DIR
  1. I $D(DIRUT) D EOJ Q
  1. S APCDDRN=Y
  1. S DIC="^AUTTREFT(",DIC(0)="AEMQ",DIC("A")="Enter Service Type: " D ^DIC K DIC
  1. I Y=-1 W !,"exiting......." Q
  1. S APCDX=+Y
  1. VALUE ;EP - called from input template
  1. S APCDTF=$P(^AUTTREFT(APCDX,0),U,2)
  1. I 'APCDTF S APCDTERR=1 D EOJ Q
  1. 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
  1. I Y=-1 W !!,"Invalid entry. Try again." G REF
  1. S APCDTIEN=+Y,APCDTID=$$VAL^XBDIQ1(APCDTF,APCDTIEN,$P(^AUTTREFT(APCDX,0),U,3))
  1. S DIR(0)="9000022,.07",DIR("A")="Enter Reason not Done" KILL DA D ^DIR KILL DIR
  1. I $D(DIRUT) W !,"Reason is Required" G REF
  1. I Y="" W !,"Reason is Required" G REF
  1. S APCDTREA=Y
  1. W !,"creating Refusal entry in PCC..."
  1. K DIC,DLAYGO,DIADD
  1. 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
  1. I Y=-1 W !!,"Creating refusal entry failed...." H 2 D ^XBFMK G REF
  1. D ^XBFMK
  1. K DIADD,DLAYGO
  1. 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
  1. I $D(DIRUT) D EOJ Q
  1. I 'Y D EOJ Q
  1. G REF
  1. EOJ ;
  1. K APCDX,APCDTF,APCDTERR,APCDTOLD,APCDTID,APCDTIEN
  1. D ^XBFMK
  1. K Y
  1. Q
  1. BTL(A) ;EP - called from screen on BARRIERS TO LEARN
  1. I '$D(^AUTTHF(A,0)) Q 0
  1. I $P(^AUTTHF(A,0),U,10)'="F" Q 0
  1. I $P(^AUTTHF(A,0),U,13) Q 0
  1. NEW B S B=$O(^AUTTHF("B","BARRIERS TO LEARNING",0)) I 'B Q 0
  1. I $P(^AUTTHF(A,0),U,3)'=B Q 0
  1. Q 1
  1. ;
  1. RTL(A) ;EP - called from dd
  1. I '$D(^AUTTHF(A,0)) Q 0
  1. I $P(^AUTTHF(A,0),U,10)'="F" Q 0
  1. I $P(^AUTTHF(A,0),U,13) Q 0
  1. NEW B S B=$O(^AUTTHF("B","READINESS TO LEARN",0)) I 'B Q 0
  1. I $P(^AUTTHF(A,0),U,3)'=B Q 0
  1. Q 1
  1. ;
  1. LP(A) ;EP - called from screen on LEARNING PREFERENCE
  1. I '$D(^AUTTHF(A,0)) Q 0
  1. I $P(^AUTTHF(A,0),U,10)'="F" Q 0
  1. I $P(^AUTTHF(A,0),U,13) Q 0
  1. NEW B S B=$O(^AUTTHF("B","LEARNING PREFERENCE",0)) I 'B Q 0
  1. I $P(^AUTTHF(A,0),U,3)'=B Q 0
  1. Q 1
  1. BTLHF ;EP
  1. K APCDVSIT
  1. I $P($G(^APCDDMUP(APCDDA,11)),U,8)="" Q
  1. S APCDDMDT=$S($P(APCDREC1,U,17)]"":$P(APCDREC1,U,17),1:DT)
  1. S APCDMTYP=$P(^APCDDMUP(APCDDA,11),U,8)
  1. S APCDMCAT=$P(^AUTTHF(APCDMTYP,0),U,3)
  1. D EVSIT^APCDDMUP ;get event visit
  1. I '$G(APCDVSIT) S T="Could not Create PCC Visit when attempting to update Barriers to Learning health factor." D ERR^APCDDMUP(T) Q
  1. 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
  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
  1. K APCDALVR
  1. S APCDALVR("APCDPAT")=APCDDMPT
  1. S APCDALVR("APCDVSIT")=APCDVSIT
  1. S APCDALVR("APCDATMP")="[APCDALVR 9000010.23 (ADD)]"
  1. S APCDALVR("APCDTHF")="`"_APCDMTYP
  1. D ^APCDALVR
  1. I $D(APCDALVR("APCDAFLG")) S T="Error creating V Health Factor Entry for Barriers to Learning. PCC not updated." D ERR^APCDDMUP(T)
  1. K APCDALVR
  1. ;update health status
  1. ;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
  1. ;I APCDHSE D Q
  1. ;.D ^XBFMK K DIADD
  1. ;.S DA=APCDHSE,DIE="^AUPNHF(",DR=".01///`"_APCDMTYP_";.03////"_DT D ^DIE
  1. ;.I $D(Y) S T="Error updating Health Status entry for Barriers to Learning." D ERR^APCDDMUP(T)
  1. ;.D ^XBFMK
  1. ;D ^XBFMK
  1. ;S X=APCDMTYP,DIC("DR")=".02////"_APCDDMPT_";.03////"_DT,DIC(0)="L",DIADD=1,DLAYGO=9000019,DIC="^AUPNHF(" D FILE^DICN
  1. ;I Y=-1 S T="Error adding health status entry for Barriers to Learning." D ERR^APCDDMUP(T)
  1. D ^XBFMK K DIADD,DLAYGO
  1. Q
  1. RTLHF ;EP
  1. K APCDVSIT
  1. I $P($G(^APCDDMUP(APCDDA,11)),U,9)="" Q
  1. S APCDDMDT=$S($P(APCDREC1,U,18)]"":$P(APCDREC1,U,18),1:DT)
  1. S APCDMTYP=$P(^APCDDMUP(APCDDA,11),U,9)
  1. S APCDMCAT=$P(^AUTTHF(APCDMTYP,0),U,3)
  1. D EVSIT^APCDDMUP ;get event visit
  1. I '$G(APCDVSIT) S T="Could not Create PCC Visit when attempting to update READINESS TO LEARN health factor." D ERR^APCDDMUP(T) Q
  1. 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
  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
  1. K APCDALVR
  1. S APCDALVR("APCDPAT")=APCDDMPT
  1. S APCDALVR("APCDVSIT")=APCDVSIT
  1. S APCDALVR("APCDATMP")="[APCDALVR 9000010.23 (ADD)]"
  1. S APCDALVR("APCDTHF")="`"_APCDMTYP
  1. D ^APCDALVR
  1. I $D(APCDALVR("APCDAFLG")) S T="Error creating V Health Factor Entry for READINESS TO LEARN. PCC not updated." D ERR^APCDDMUP(T)
  1. K APCDALVR
  1. ;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
  1. ;I APCDHSE D Q
  1. ;.D ^XBFMK K DIADD
  1. ;.S DA=APCDHSE,DIE="^AUPNHF(",DR=".01///`"_APCDMTYP_";.03////"_DT D ^DIE
  1. ;.I $D(Y) S T="Error updating Health Status entry for READINESS TO LEARN." D ERR^APCDDMUP(T)
  1. ;.D ^XBFMK
  1. ;D ^XBFMK
  1. ;S X=APCDMTYP,DIC("DR")=".02////"_APCDDMPT_";.03////"_DT,DIC(0)="L",DIADD=1,DLAYGO=9000019,DIC="^AUPNHF(" D FILE^DICN
  1. ;I Y=-1 S T="Error adding health status entry for READINESS TO LEARN." D ERR^APCDDMUP(T)
  1. D ^XBFMK K DIADD,DLAYGO
  1. Q
  1. ;
  1. LPHF ;EP
  1. K APCDVSIT
  1. I $P($G(^APCDDMUP(APCDDA,11)),U,10)="" Q
  1. S APCDDMDT=$S($P(APCDREC1,U,19)]"":$P(APCDREC1,U,19),1:DT)
  1. S APCDMTYP=$P(^APCDDMUP(APCDDA,11),U,10)
  1. S APCDMCAT=$P(^AUTTHF(APCDMTYP,0),U,3)
  1. D EVSIT^APCDDMUP ;get event visit
  1. I '$G(APCDVSIT) S T="Could not Create PCC Visit when attempting to update LEARNING PREFERENCE health factor." D ERR^APCDDMUP(T) Q
  1. 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
  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
  1. K APCDALVR
  1. S APCDALVR("APCDPAT")=APCDDMPT
  1. S APCDALVR("APCDVSIT")=APCDVSIT
  1. S APCDALVR("APCDATMP")="[APCDALVR 9000010.23 (ADD)]"
  1. S APCDALVR("APCDTHF")="`"_APCDMTYP
  1. D ^APCDALVR
  1. I $D(APCDALVR("APCDAFLG")) S T="Error creating V Health Factor Entry for LEARNING PREFERENCE. PCC not updated." D ERR^APCDDMUP(T)
  1. K APCDALVR
  1. ;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
  1. ;I APCDHSE D Q
  1. ;.D ^XBFMK K DIADD
  1. ;.S DA=APCDHSE,DIE="^AUPNHF(",DR=".01///`"_APCDMTYP_";.03////"_DT D ^DIE
  1. ;.I $D(Y) S T="Error updating Health Status entry for LEARNING PREFERENCE." D ERR^APCDDMUP(T)
  1. ;.D ^XBFMK
  1. ;D ^XBFMK
  1. ;S X=APCDMTYP,DIC("DR")=".02////"_APCDDMPT_";.03////"_DT,DIC(0)="L",DIADD=1,DLAYGO=9000019,DIC="^AUPNHF(" D FILE^DICN
  1. ;I Y=-1 S T="Error adding health status entry for LEARNING PREFERENCE." D ERR^APCDDMUP(T)
  1. D ^XBFMK K DIADD,DLAYGO
  1. Q
  1. ;