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

PXRMP19A.m

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