PXRMP19A ;BP/WAT;post-install for patch 19 con't ;02/27/17 13:31
;;2.0;CLINICAL REMINDERS;**19**;Feb 04, 2005;Build 187
Q
;INTEGRATION AGREEMENTS
;;3083 ^AUTTHF( | 10141 ^XPDUTL | 10103 ^XLFDT | 10104 ^XLFSTR | 10063 ^%ZTLOAD | 2263 ^XPAR | 1131 XMB("NETNAME")
;;10066 XMZ^XMA2 | 10070 ENT1^XMD | 2172 XPDID | 10113 ^XMB(3.9
;
QUEUE(PXRMSG,ZTRTN,ZTDESC,PXRMITEM) ;CREATE A SPECIFIED TASK
;PARAMETERS: PXRMSG => STRING CONTAINING THE TEXT TO OUTPUT TO THE SCREEN
; ZTRTN => STRING CONTAINING THE ROUTINE TASKMAN SHOULD EXECUTE
; ZTDESC => STRING CONTAINING THE TASK'S DESCRIPTION
; PXRMITEM => REFERENCE TO THE VARIABLE STORING THE NUMBER OF THE CURRENT ITEM
N ZTDTH,ZTIO,ZTSK,ZTSAVE
S ZTSAVE("^TMP(""PXRM_CCHTHF"",$J,")=""
S ZTSAVE("DUZ")=$G(DUZ)
D BMES^XPDUTL("Queueing "_PXRMSG_"...")
S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,0,0,0,10)
S ZTIO=""
D ^%ZTLOAD
S ZTREQ="@"
I +$G(ZTSK)=0 D
.I $G(PXRMPOST) D BMES^XPDUTL("Unable to queue the "_PXRMSG_"; file a Remedy ticket for assistance.")
.E W "ERROR",!,"Unable to queue the "_PXRMSG_"; file a Remedy ticket for assistance.",!
E D
.I $G(PXRMPOST) D
..D BMES^XPDUTL("DONE - Task #"_ZTSK)
..D UPDATE^XPDID($G(PXRMITEM))
..S PXRMITEM=PXRMITEM+1
.E W "DONE",!,"Task #"_ZTSK,!
Q
SEND(NODE,SUBJECT,FROM) ;Send a MailMan message whose text is in ^TMP(NODE,$J,N,0).
N SUBSCR,NL,REF,XMDUZ,XMSUB,XMY,XMZ S SUBSCR="PXRM19RECIPS"
I $Q(^XTMP(SUBSCR,0))[SUBSCR D
.M XMY=^XTMP(SUBSCR)
E S XMY(DUZ)=""
I $D(ZTQUEUED)>0 D
.S XMY(DUZ)=""
S XMSUB=$E(SUBJECT,1,64)
S XMDUZ=$G(FROM)
;
RETRY ;Get the message number.
D XMZ^XMA2
I XMZ<1 G RETRY
;
;Load message, send
M ^XMB(3.9,XMZ,2)=^TMP(NODE,$J)
K ^TMP(NODE,$J)
S NL=$O(^XMB(3.9,XMZ,2,""),-1)
S ^XMB(3.9,XMZ,2,0)="^3.92^"_+NL_U_+NL_U_DT
D ENT1^XMD Q
Q
;
MAIN ; main module
K ^TMP("PXRMPATS",$J)
N INC,NODE,SUBJ,FROM S INC=1,NODE="PXRM_CCHTHF",SUBJ="LOCAL CCHT HFs NOT USED IN NAT'L HT CLIN REMINDER CONTENT",FROM="PXRM*2.0*19 Install@"_^XMB("NETNAME")
D LOCHF
D SEND(NODE,SUBJ,FROM)
D CLNTMP
Q
;
CLNTMP ;need to check clean up of TMP arrays when done with them
K ^TMP("PXRM19HF",$J)
K ^TMP("PXRM_CCHTHF",$J)
K ^XTMP("PXRM19RECIPS")
Q
;
LOCHF ;report out local CCHT HFs not used in HT reminder content
;build list of all HFs in the HT content
;build list of all local "CCHT" or "CARE COORDIATION HOME TELEHEALTH" HFs
;compare the two lists and report out any local HFs that are NOT used by HT
N NODEA,NODEB,CATEGORY,INACTIVE,HFIEN,COUNT,FLAG
S NODEA="PXRM19HF",NODEB="PXRM_CCHTHF",COUNT=3
D HTHFTMP,HFLKUP,COMPARE(NODEA,NODEB)
I $D(^TMP("PXRM_CCHTHF",$J))'>0 S ^TMP("PXRM_CCHTHF",$J,1,0)="No local CCHT/CARE COORDINATION health factors found." Q
;add category and inactive values to TMP array entries
F S COUNT=$O(^TMP("PXRM_CCHTHF",$J,COUNT)) Q:$G(COUNT)="" D
. S HFIEN=$P(^TMP("PXRM_CCHTHF",$J,COUNT,0),"^")
. S:$G(HFIEN) CATEGORY=$P(^AUTTHF(HFIEN,0),"^",3)
. S:$G(CATEGORY) CATEGORY=$P(^AUTTHF(CATEGORY,0),"^",1)
. I $L(CATEGORY)<40 S CATEGORY=CATEGORY_$$REPEAT^XLFSTR(" ",(40-$L(CATEGORY)))
. S FLAG=$P(^AUTTHF(HFIEN,0),"^",11)
. S ^TMP("PXRM_CCHTHF",$J,COUNT,0)=$P(^TMP("PXRM_CCHTHF",$J,COUNT,0),U,2)
. S ^TMP("PXRM_CCHTHF",$J,COUNT+.1,0)=$J($G(CATEGORY),47)_$J($S($G(FLAG)=1:"YES",1:"NO"),17)
. S COUNT=$O(^TMP("PXRM_CCHTHF",$J,COUNT)) ;need this to get past the X.1 subscript set in the line above
;add header text
S ^TMP("PXRM_CCHTHF",$J,1,0)="HEALTH FACTOR"
S ^TMP("PXRM_CCHTHF",$J,2,0)=$J("CATEGORY",15)_$J("INACTIVE?",55)
S ^TMP("PXRM_CCHTHF",$J,3,0)=$$REPEAT^XLFSTR("-",78)
Q
;
HTHFTMP ;build TMP array of HT HFs
K ^TMP("PXRM19HF",$J)
N PXRMI,PXRMFCTR,PXRMCNT
S PXRMCNT=1
F PXRMI=1:1 S PXRMFCTR=$P($T(HF+PXRMI^PXRMP19B),";",3) Q:PXRMFCTR="EOF" D
.I PXRMFCTR="HT (CARE COORDINATION HOME TELEHEALTH)" S PXRMFCTR="HT (HOME TELEHEALTH)"
.S ^TMP("PXRM19HF",$J,PXRMCNT)=PXRMFCTR,PXRMCNT=PXRMCNT+1
Q
;
COMPARE(PXRMA,PXRMB) ; compare list PXRMA and PXRMB. Remove duplicate items from PXRMB
Q:'$D(^TMP(PXRMA,$J))
Q:'$D(^TMP(PXRMB,$J))
N ACOUNT,BCOUNT,HFA,HFB,INDEX S (ACOUNT,BCOUNT,INDEX)=0
F S BCOUNT=$O(^TMP(PXRMB,$J,BCOUNT)) Q:BCOUNT="" D
. S HFB=^TMP(PXRMB,$J,BCOUNT,0),HFB=$P(HFB,U,2)
. F S ACOUNT=$O(^TMP(PXRMA,$J,ACOUNT)) Q:ACOUNT="" D
. . S HFA=^TMP(PXRMA,$J,ACOUNT)
. . I HFA=HFB K ^TMP(PXRMB,$J,BCOUNT) ;leave only non-matches in PXRM_CCHTHF
Q
;
HFLKUP ;find local HFs with "CCHT" or "CARE COORDINATION" in name or category
;^TMP("PXRM_CCHTHF",$J)=IEN OF HF ^ NAME OF HF
K ^TMP("PXRM_CCHTHF",$J)
N HFIEN,HFNAME,HFCAT,CNT S HFIEN=0,HFNAME="",CNT=4
F S HFNAME=$O(^AUTTHF("B",HFNAME)) Q:HFNAME="" D
.S HFIEN=$O(^AUTTHF("B",HFNAME,"")) Q:HFIEN'>99999
.S HFCAT=$P(^AUTTHF(HFIEN,0),U,3) I $G(HFCAT)'="" D
..I $D(^AUTTHF(HFCAT))>0 S HFCAT=$P(^AUTTHF(HFCAT,0),U)
.I (HFNAME["CCHT")!(HFNAME["CARE COORDINATION HOME TELEHEALTH")!(HFCAT["CCHT")!(HFCAT["CARE COORDINATION HOME TELEHEALTH") D
..S ^TMP("PXRM_CCHTHF",$J,CNT,0)=HFIEN_"^"_HFNAME_"^0",CNT=CNT+1
Q
;
ORWPCE(PXRMITEM) ;set parameter value to true
;;HT (HOME TELEHEALTH)
;;HT ASSESSMENT/TREATMENT PLAN
;;HT CAREGIVER RISK ASSESSMENT SCREEN
;;HT CONTINUUM OF CARE (CCF)
;;HT DISCHARGE
;;HT REFERRALS FOR VETERAN/CAREGIVER
;;HT TELEHEALTH DELIVERY/INSTALL MODE
;;HT TELEHEALTH DEMOGRAPHICS
D BMES^XPDUTL("Checking ORWPCE EXCLUDE HEALTH FACTORS at the SYSTEM level")
D MES^XPDUTL("for each HT Health Factor Category")
N HFIEN,HFCATNAM,PXRMERR,LVL,PAR,PXRMPAR,CNT,LASTVAL
S PAR="ORWPCE EXCLUDE HEALTH FACTORS",LVL="SYS"
F CNT=1:1:8 D
.D GETLST^XPAR(.PXRMPAR,LVL,PAR,"I",.PXRMERR)
.S HFCATNAM=$P($T(ORWPCE+CNT),";;",2)
.S HFIEN=$O(^AUTTHF("B",HFCATNAM,""))
.D:$$CHKLIST(HFIEN,.PXRMPAR)=0&(HFIEN>0)
..S LASTVAL=$O(PXRMPAR(""),-1)
..S LASTVAL=LASTVAL+1
..D EN^XPAR(LVL,PAR,LASTVAL,"`"_$G(HFIEN),.PXRMERR)
..I +$G(PXRMERR)=0 D MES^XPDUTL("Parameter set for "_HFCATNAM)
..I +$G(PXRMERR)>0 D BMES^XPDUTL("ERROR: "_$P(PXRMERR,U,2))
I $G(PXRMPOST) D
.D UPDATE^XPDID($G(PXRMITEM))
.S PXRMITEM=PXRMITEM+1
Q
;
TIURMDLG(PXRMITEM) ;set parameter value to true
;;VA-HT ASSESSMENT TREATMENT PLAN TEMPLATE
;;VA-HT CAREGIVER ASSESSMENT TEMPLATE
;;VA-HT CONTINUUM OF CARE TEMPLATE
;;VA-HT DISCHARGE TEMPLATE
;;VA-HT INTERVENTION TEMPLATE
;;VA-HT PERIODIC EVALUATION
;;VA-HT SCREENING CONSULT TEMPLATE
;;VA-HT TECH EDUCATION & INSTALLATION TEMPLATE
;;VA-HT TEMPLATE FOR PREVIOUSLY ENROLLED PATIENTS
;;VA-HT VIDEO VISIT TEMPLATE
N CNT,LASTVAL,PAR,LVL,PXRMPAR,PXRMERR,DIEN,DNAME
D BMES^XPDUTL("Checking TIU TEMPLATE REMINDER DIALOGS at the SYSTEM level")
S PAR="TIU TEMPLATE REMINDER DIALOGS",LVL="SYS"
F CNT=1:1:10 D
.D GETLST^XPAR(.PXRMPAR,LVL,PAR,"I",.PXRMERR)
.S DNAME=$P($T(TIURMDLG+CNT),";;",2)
.S DIEN=$O(^PXRMD(801.41,"B",DNAME,"")) Q:+$G(DIEN)'>0
.D:$$CHKLIST($G(DIEN),.PXRMPAR)=0
..S LASTVAL=$O(PXRMPAR(""),-1)
..S LASTVAL=LASTVAL+1
..D EN^XPAR(LVL,PAR,LASTVAL,"`"_$G(DIEN),.PXRMERR)
..I +$G(PXRMERR)=0 D MES^XPDUTL("Parameter set for "_DNAME)
..I +$G(PXRMERR)>0 D BMES^XPDUTL("ERROR: "_$P(PXRMERR,U,2))
I $G(PXRMPOST) D
.D UPDATE^XPDID($G(PXRMITEM))
.S PXRMITEM=PXRMITEM+1
Q
;
CHKLIST(IEN,LIST) ;see if parameter value is already set
N I,CHECK S CHECK=0,I=""
Q:LIST'>0 CHECK
F S I=$O(LIST(I)) Q:I=""!(CHECK=1) D
.I $G(LIST(I))=IEN S CHECK=1
Q CHECK
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMP19A 7487 printed Nov 22, 2024@16:57:22 Page 2
PXRMP19A ;BP/WAT;post-install for patch 19 con't ;02/27/17 13:31
+1 ;;2.0;CLINICAL REMINDERS;**19**;Feb 04, 2005;Build 187
+2 QUIT
+3 ;INTEGRATION AGREEMENTS
+4 ;;3083 ^AUTTHF( | 10141 ^XPDUTL | 10103 ^XLFDT | 10104 ^XLFSTR | 10063 ^%ZTLOAD | 2263 ^XPAR | 1131 XMB("NETNAME")
+5 ;;10066 XMZ^XMA2 | 10070 ENT1^XMD | 2172 XPDID | 10113 ^XMB(3.9
+6 ;
QUEUE(PXRMSG,ZTRTN,ZTDESC,PXRMITEM) ;CREATE A SPECIFIED TASK
+1 ;PARAMETERS: PXRMSG => STRING CONTAINING THE TEXT TO OUTPUT TO THE SCREEN
+2 ; ZTRTN => STRING CONTAINING THE ROUTINE TASKMAN SHOULD EXECUTE
+3 ; ZTDESC => STRING CONTAINING THE TASK'S DESCRIPTION
+4 ; PXRMITEM => REFERENCE TO THE VARIABLE STORING THE NUMBER OF THE CURRENT ITEM
+5 NEW ZTDTH,ZTIO,ZTSK,ZTSAVE
+6 SET ZTSAVE("^TMP(""PXRM_CCHTHF"",$J,")=""
+7 SET ZTSAVE("DUZ")=$GET(DUZ)
+8 DO BMES^XPDUTL("Queueing "_PXRMSG_"...")
+9 SET ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,0,0,0,10)
+10 SET ZTIO=""
+11 DO ^%ZTLOAD
+12 SET ZTREQ="@"
+13 IF +$GET(ZTSK)=0
Begin DoDot:1
+14 IF $GET(PXRMPOST)
DO BMES^XPDUTL("Unable to queue the "_PXRMSG_"; file a Remedy ticket for assistance.")
+15 IF '$TEST
WRITE "ERROR",!,"Unable to queue the "_PXRMSG_"; file a Remedy ticket for assistance.",!
End DoDot:1
+16 IF '$TEST
Begin DoDot:1
+17 IF $GET(PXRMPOST)
Begin DoDot:2
+18 DO BMES^XPDUTL("DONE - Task #"_ZTSK)
+19 DO UPDATE^XPDID($GET(PXRMITEM))
+20 SET PXRMITEM=PXRMITEM+1
End DoDot:2
+21 IF '$TEST
WRITE "DONE",!,"Task #"_ZTSK,!
End DoDot:1
+22 QUIT
SEND(NODE,SUBJECT,FROM) ;Send a MailMan message whose text is in ^TMP(NODE,$J,N,0).
+1 NEW SUBSCR,NL,REF,XMDUZ,XMSUB,XMY,XMZ
SET SUBSCR="PXRM19RECIPS"
+2 IF $QUERY(^XTMP(SUBSCR,0))[SUBSCR
Begin DoDot:1
+3 MERGE XMY=^XTMP(SUBSCR)
End DoDot:1
+4 IF '$TEST
SET XMY(DUZ)=""
+5 IF $DATA(ZTQUEUED)>0
Begin DoDot:1
+6 SET XMY(DUZ)=""
End DoDot:1
+7 SET XMSUB=$EXTRACT(SUBJECT,1,64)
+8 SET XMDUZ=$GET(FROM)
+9 ;
RETRY ;Get the message number.
+1 DO XMZ^XMA2
+2 IF XMZ<1
GOTO RETRY
+3 ;
+4 ;Load message, send
+5 MERGE ^XMB(3.9,XMZ,2)=^TMP(NODE,$JOB)
+6 KILL ^TMP(NODE,$JOB)
+7 SET NL=$ORDER(^XMB(3.9,XMZ,2,""),-1)
+8 SET ^XMB(3.9,XMZ,2,0)="^3.92^"_+NL_U_+NL_U_DT
+9 DO ENT1^XMD
QUIT
+10 QUIT
+11 ;
MAIN ; main module
+1 KILL ^TMP("PXRMPATS",$JOB)
+2 NEW INC,NODE,SUBJ,FROM
SET INC=1
SET NODE="PXRM_CCHTHF"
SET SUBJ="LOCAL CCHT HFs NOT USED IN NAT'L HT CLIN REMINDER CONTENT"
SET FROM="PXRM*2.0*19 Install@"_^XMB("NETNAME")
+3 DO LOCHF
+4 DO SEND(NODE,SUBJ,FROM)
+5 DO CLNTMP
+6 QUIT
+7 ;
CLNTMP ;need to check clean up of TMP arrays when done with them
+1 KILL ^TMP("PXRM19HF",$JOB)
+2 KILL ^TMP("PXRM_CCHTHF",$JOB)
+3 KILL ^XTMP("PXRM19RECIPS")
+4 QUIT
+5 ;
LOCHF ;report out local CCHT HFs not used in HT reminder content
+1 ;build list of all HFs in the HT content
+2 ;build list of all local "CCHT" or "CARE COORDIATION HOME TELEHEALTH" HFs
+3 ;compare the two lists and report out any local HFs that are NOT used by HT
+4 NEW NODEA,NODEB,CATEGORY,INACTIVE,HFIEN,COUNT,FLAG
+5 SET NODEA="PXRM19HF"
SET NODEB="PXRM_CCHTHF"
SET COUNT=3
+6 DO HTHFTMP
DO HFLKUP
DO COMPARE(NODEA,NODEB)
+7 IF $DATA(^TMP("PXRM_CCHTHF",$JOB))'>0
SET ^TMP("PXRM_CCHTHF",$JOB,1,0)="No local CCHT/CARE COORDINATION health factors found."
QUIT
+8 ;add category and inactive values to TMP array entries
+9 FOR
SET COUNT=$ORDER(^TMP("PXRM_CCHTHF",$JOB,COUNT))
if $GET(COUNT)=""
QUIT
Begin DoDot:1
+10 SET HFIEN=$PIECE(^TMP("PXRM_CCHTHF",$JOB,COUNT,0),"^")
+11 if $GET(HFIEN)
SET CATEGORY=$PIECE(^AUTTHF(HFIEN,0),"^",3)
+12 if $GET(CATEGORY)
SET CATEGORY=$PIECE(^AUTTHF(CATEGORY,0),"^",1)
+13 IF $LENGTH(CATEGORY)<40
SET CATEGORY=CATEGORY_$$REPEAT^XLFSTR(" ",(40-$LENGTH(CATEGORY)))
+14 SET FLAG=$PIECE(^AUTTHF(HFIEN,0),"^",11)
+15 SET ^TMP("PXRM_CCHTHF",$JOB,COUNT,0)=$PIECE(^TMP("PXRM_CCHTHF",$JOB,COUNT,0),U,2)
+16 SET ^TMP("PXRM_CCHTHF",$JOB,COUNT+.1,0)=$JUSTIFY($GET(CATEGORY),47)_$JUSTIFY($SELECT($GET(FLAG)=1:"YES",1:"NO"),17)
+17 ;need this to get past the X.1 subscript set in the line above
SET COUNT=$ORDER(^TMP("PXRM_CCHTHF",$JOB,COUNT))
End DoDot:1
+18 ;add header text
+19 SET ^TMP("PXRM_CCHTHF",$JOB,1,0)="HEALTH FACTOR"
+20 SET ^TMP("PXRM_CCHTHF",$JOB,2,0)=$JUSTIFY("CATEGORY",15)_$JUSTIFY("INACTIVE?",55)
+21 SET ^TMP("PXRM_CCHTHF",$JOB,3,0)=$$REPEAT^XLFSTR("-",78)
+22 QUIT
+23 ;
HTHFTMP ;build TMP array of HT HFs
+1 KILL ^TMP("PXRM19HF",$JOB)
+2 NEW PXRMI,PXRMFCTR,PXRMCNT
+3 SET PXRMCNT=1
+4 FOR PXRMI=1:1
SET PXRMFCTR=$PIECE($TEXT(HF+PXRMI^PXRMP19B),";",3)
if PXRMFCTR="EOF"
QUIT
Begin DoDot:1
+5 IF PXRMFCTR="HT (CARE COORDINATION HOME TELEHEALTH)"
SET PXRMFCTR="HT (HOME TELEHEALTH)"
+6 SET ^TMP("PXRM19HF",$JOB,PXRMCNT)=PXRMFCTR
SET PXRMCNT=PXRMCNT+1
End DoDot:1
+7 QUIT
+8 ;
COMPARE(PXRMA,PXRMB) ; compare list PXRMA and PXRMB. Remove duplicate items from PXRMB
+1 if '$DATA(^TMP(PXRMA,$JOB))
QUIT
+2 if '$DATA(^TMP(PXRMB,$JOB))
QUIT
+3 NEW ACOUNT,BCOUNT,HFA,HFB,INDEX
SET (ACOUNT,BCOUNT,INDEX)=0
+4 FOR
SET BCOUNT=$ORDER(^TMP(PXRMB,$JOB,BCOUNT))
if BCOUNT=""
QUIT
Begin DoDot:1
+5 SET HFB=^TMP(PXRMB,$JOB,BCOUNT,0)
SET HFB=$PIECE(HFB,U,2)
+6 FOR
SET ACOUNT=$ORDER(^TMP(PXRMA,$JOB,ACOUNT))
if ACOUNT=""
QUIT
Begin DoDot:2
+7 SET HFA=^TMP(PXRMA,$JOB,ACOUNT)
+8 ;leave only non-matches in PXRM_CCHTHF
IF HFA=HFB
KILL ^TMP(PXRMB,$JOB,BCOUNT)
End DoDot:2
End DoDot:1
+9 QUIT
+10 ;
HFLKUP ;find local HFs with "CCHT" or "CARE COORDINATION" in name or category
+1 ;^TMP("PXRM_CCHTHF",$J)=IEN OF HF ^ NAME OF HF
+2 KILL ^TMP("PXRM_CCHTHF",$JOB)
+3 NEW HFIEN,HFNAME,HFCAT,CNT
SET HFIEN=0
SET HFNAME=""
SET CNT=4
+4 FOR
SET HFNAME=$ORDER(^AUTTHF("B",HFNAME))
if HFNAME=""
QUIT
Begin DoDot:1
+5 SET HFIEN=$ORDER(^AUTTHF("B",HFNAME,""))
if HFIEN'>99999
QUIT
+6 SET HFCAT=$PIECE(^AUTTHF(HFIEN,0),U,3)
IF $GET(HFCAT)'=""
Begin DoDot:2
+7 IF $DATA(^AUTTHF(HFCAT))>0
SET HFCAT=$PIECE(^AUTTHF(HFCAT,0),U)
End DoDot:2
+8 IF (HFNAME["CCHT")!(HFNAME["CARE COORDINATION HOME TELEHEALTH")!(HFCAT["CCHT")!(HFCAT["CARE COORDINATION HOME TELEHEALTH")
Begin DoDot:2
+9 SET ^TMP("PXRM_CCHTHF",$JOB,CNT,0)=HFIEN_"^"_HFNAME_"^0"
SET CNT=CNT+1
End DoDot:2
End DoDot:1
+10 QUIT
+11 ;
ORWPCE(PXRMITEM) ;set parameter value to true
+1 ;;HT (HOME TELEHEALTH)
+2 ;;HT ASSESSMENT/TREATMENT PLAN
+3 ;;HT CAREGIVER RISK ASSESSMENT SCREEN
+4 ;;HT CONTINUUM OF CARE (CCF)
+5 ;;HT DISCHARGE
+6 ;;HT REFERRALS FOR VETERAN/CAREGIVER
+7 ;;HT TELEHEALTH DELIVERY/INSTALL MODE
+8 ;;HT TELEHEALTH DEMOGRAPHICS
+9 DO BMES^XPDUTL("Checking ORWPCE EXCLUDE HEALTH FACTORS at the SYSTEM level")
+10 DO MES^XPDUTL("for each HT Health Factor Category")
+11 NEW HFIEN,HFCATNAM,PXRMERR,LVL,PAR,PXRMPAR,CNT,LASTVAL
+12 SET PAR="ORWPCE EXCLUDE HEALTH FACTORS"
SET LVL="SYS"
+13 FOR CNT=1:1:8
Begin DoDot:1
+14 DO GETLST^XPAR(.PXRMPAR,LVL,PAR,"I",.PXRMERR)
+15 SET HFCATNAM=$PIECE($TEXT(ORWPCE+CNT),";;",2)
+16 SET HFIEN=$ORDER(^AUTTHF("B",HFCATNAM,""))
+17 if $$CHKLIST(HFIEN,.PXRMPAR)=0&(HFIEN>0)
Begin DoDot:2
+18 SET LASTVAL=$ORDER(PXRMPAR(""),-1)
+19 SET LASTVAL=LASTVAL+1
+20 DO EN^XPAR(LVL,PAR,LASTVAL,"`"_$GET(HFIEN),.PXRMERR)
+21 IF +$GET(PXRMERR)=0
DO MES^XPDUTL("Parameter set for "_HFCATNAM)
+22 IF +$GET(PXRMERR)>0
DO BMES^XPDUTL("ERROR: "_$PIECE(PXRMERR,U,2))
End DoDot:2
End DoDot:1
+23 IF $GET(PXRMPOST)
Begin DoDot:1
+24 DO UPDATE^XPDID($GET(PXRMITEM))
+25 SET PXRMITEM=PXRMITEM+1
End DoDot:1
+26 QUIT
+27 ;
TIURMDLG(PXRMITEM) ;set parameter value to true
+1 ;;VA-HT ASSESSMENT TREATMENT PLAN TEMPLATE
+2 ;;VA-HT CAREGIVER ASSESSMENT TEMPLATE
+3 ;;VA-HT CONTINUUM OF CARE TEMPLATE
+4 ;;VA-HT DISCHARGE TEMPLATE
+5 ;;VA-HT INTERVENTION TEMPLATE
+6 ;;VA-HT PERIODIC EVALUATION
+7 ;;VA-HT SCREENING CONSULT TEMPLATE
+8 ;;VA-HT TECH EDUCATION & INSTALLATION TEMPLATE
+9 ;;VA-HT TEMPLATE FOR PREVIOUSLY ENROLLED PATIENTS
+10 ;;VA-HT VIDEO VISIT TEMPLATE
+11 NEW CNT,LASTVAL,PAR,LVL,PXRMPAR,PXRMERR,DIEN,DNAME
+12 DO BMES^XPDUTL("Checking TIU TEMPLATE REMINDER DIALOGS at the SYSTEM level")
+13 SET PAR="TIU TEMPLATE REMINDER DIALOGS"
SET LVL="SYS"
+14 FOR CNT=1:1:10
Begin DoDot:1
+15 DO GETLST^XPAR(.PXRMPAR,LVL,PAR,"I",.PXRMERR)
+16 SET DNAME=$PIECE($TEXT(TIURMDLG+CNT),";;",2)
+17 SET DIEN=$ORDER(^PXRMD(801.41,"B",DNAME,""))
if +$GET(DIEN)'>0
QUIT
+18 if $$CHKLIST($GET(DIEN),.PXRMPAR)=0
Begin DoDot:2
+19 SET LASTVAL=$ORDER(PXRMPAR(""),-1)
+20 SET LASTVAL=LASTVAL+1
+21 DO EN^XPAR(LVL,PAR,LASTVAL,"`"_$GET(DIEN),.PXRMERR)
+22 IF +$GET(PXRMERR)=0
DO MES^XPDUTL("Parameter set for "_DNAME)
+23 IF +$GET(PXRMERR)>0
DO BMES^XPDUTL("ERROR: "_$PIECE(PXRMERR,U,2))
End DoDot:2
End DoDot:1
+24 IF $GET(PXRMPOST)
Begin DoDot:1
+25 DO UPDATE^XPDID($GET(PXRMITEM))
+26 SET PXRMITEM=PXRMITEM+1
End DoDot:1
+27 QUIT
+28 ;
CHKLIST(IEN,LIST) ;see if parameter value is already set
+1 NEW I,CHECK
SET CHECK=0
SET I=""
+2 if LIST'>0
QUIT CHECK
+3 FOR
SET I=$ORDER(LIST(I))
if I=""!(CHECK=1)
QUIT
Begin DoDot:1
+4 IF $GET(LIST(I))=IEN
SET CHECK=1
End DoDot:1
+5 QUIT CHECK
