Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMRPCC.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMRPCC.m
r613 r623 1 PXRMRPCC ;SLC/PJH - PXRM REMINDER DIALOG ;11/26/2007 2 ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123 3 ; 4 ACTIVE(ORY,ORREM) ;Check if active dialog exist for reminders 5 ; 6 ; input parameter ORREM is array of reminder ien [.01#811.9] 7 N DDIS,DIEN,OCNT,RIEN,RSTA 8 S OCNT=0,RIEN=0 9 ;Get reminder ien from array 10 F S RIEN=$O(ORREM(RIEN)) Q:'RIEN D 11 .;Dialog ien for reminder 12 .S DIEN=$P($G(^PXD(811.9,RIEN,51)),U),RSTA=0 13 .;Dialog status 14 .I DIEN S DDIS=$P($G(^PXRMD(801.41,DIEN,0)),U,3) 15 .;If dialog and dialog not disabled 16 .I DIEN,DDIS="" S RSTA=1 17 .;Return reminder and if active dialog exists 18 .S OCNT=OCNT+1,ORY(OCNT)=RIEN_U_RSTA 19 Q 20 ; 21 ; 22 DIALOG(ORY,ORREM,DFN) ;Load reminder dialog associated with the reminder 23 ; 24 ; input parameter ORREM - reminder ien [.01,#811.9] 25 ; 26 S RIEN=ORREM 27 N DATA,DIEN 28 S DIEN=$G(^PXD(811.9,ORREM,51)) 29 ; 30 ;Quit if no dialog for this reminder 31 I 'DIEN S ORY(1)="-1^no dialog for this reminder" Q 32 ; 33 ;Check if a reminder dialog and enabled 34 S DATA=$G(^PXRMD(801.41,DIEN,0)) 35 ; 36 I $P(DATA,U,4)'="R" S ORY(1)="-1^reminder dialog invalid" Q 37 ; 38 I $P(DATA,U,3) S ORY(1)="-1^reminder dialog disabled" Q 39 ; 40 ;Load dialog lines into local array 41 S ORY(0)=0_U_+$P($G(^PXRMD(801.41,DIEN,0)),U,17) 42 D LOAD^PXRMDLL(DIEN,$G(DFN)) 43 Q 44 ; 45 HDR(ORY,ORLOC) ;Progress Note Header by location/service/user 46 N ORSRV,PASS 47 ;S ORSRV=$G(^VA(200,DUZ,5)) I +ORSRV>0 S ORSRV=$P(ORSRV,U) 48 S ORSRV=$$GET1^DIQ(200,DUZ,29,"I") 49 S PASS=DUZ_";VA(200," 50 I +$G(ORLOC) S PASS=PASS_"^LOC.`"_ORLOC 51 I ORSRV>0 S PASS=PASS_"^SRV.`"_+$G(ORSRV) 52 S ORY=$$GET^XPAR(PASS_"^DIV^SYS^PKG","PXRM PROGRESS NOTE HEADERS",1,"Q") 53 Q 54 ; 55 PROMPT(ORY,ORDLG,ORDCUR,ORFTYP) ;Load additional prompts for a dialog element 56 ; 57 ; input parameters 58 ; 59 ; ORDLG - dialog element ien [.01,#801.41] 60 ; ORDCUR - 0 = current, 1 = Historical for taxonomies only 61 ; ORFTYP - finding type (CPT/POV) for taxonomies only 62 ; 63 ; These fields can be found in the output array of DIALOG^PXRMRPCC 64 ; 65 D LOAD^PXRMDLLA(ORDLG,ORDCUR,$G(ORFTYP)) 66 Q 67 ; 68 RES(ORY,ORREM) ; Reminder Resources/Inquiry 69 ; 70 ; input parameter ORREM - reminder ien [.01,#811.9] 71 ; 72 D REMVAR^PXRMINQ(.ORY,ORREM) 73 Q 74 ; 75 MH(ORY,OTEST) ; Mental Health dialog 76 ; 77 ; Input mental health instrument NAME 78 ; 79 K ^TMP($J,"YSQU") 80 N ARRAY,CNT,CNT1,FNODE,FSUB,IC,NODE,OCNT,SUB,YS 81 ;DBIA #5056 82 S YS("CODE")=OTEST D SHOWALL^YTQPXRM5(.ARRAY,.YS) 83 S OCNT=0,CNT=0 84 S SUB="ARRAY",OCNT=0 85 F S SUB=$Q(@SUB) Q:SUB="" D 86 .S FSUB=$P($P(SUB,"(",2),")"),FNODE="" 87 .F IC=1:1 S NODE=$P(FSUB,",",IC) Q:NODE="" D 88 ..I $E(NODE)="""" S NODE=$P(NODE,"""",2) 89 ..S $P(FNODE,";",IC)=NODE 90 .Q:FNODE="" 91 .S OCNT=OCNT+1,ORY(OCNT)=FNODE_U_@SUB 92 Q 93 ; 94 MHR(ORY,RESULT,ORES) ; Mental Health score and P/N text 95 ; 96 ; Input MH result IEN and mental health instrument response 97 ; 98 D START^PXRMDLR(.ORY,RESULT,.ORES) 99 ; 100 Q 101 ; 102 MHS(ORY,YS) ; Mental Health save response 103 ; 104 ; Input mental health instrument response 105 N ANS,ARRAY,X 106 S ANS=$G(YS("R1")) K YS("R1") 107 S YS("ADATE")=YS("ADATE")_"."_$P($$NOW^XLFDT,".",2) 108 F X=1:1:$L(ANS) I $E(ANS,X)'="X" S YS(X)=X_U_$E(ANS,X) 109 ;DBIA #4463 110 D SAVECR^YTQPXRM4(.ARRAY,.YS) 111 Q 112 ; 113 MST(ORY,DFN,DGMSTDT,DGMSTSC,DGMSTPR,FTYP,FIEN,RESULT) ; File MST status 114 ;This is obsolete and can be removed when the GUI is changed not 115 ;to use it. 116 Q 117 ; 118 WH(ORY,RESULT) ; 119 N CNT,CNT1,CNT2,NODE,PIECNT,PUR,TYPE,TYP1,WVIEN,WVRESULT,WVNOT,WVPURIEN 120 N PRINT 121 K ^TMP("WV RPT",$J) 122 I '$D(RESULT) Q 123 S (CNT2,WVPURIEN,PUR)=0 124 S CNT=0 F S CNT=$O(RESULT(CNT)) Q:CNT="" D 125 . I $P($G(RESULT(CNT)),U)["WHIEN" D 126 . . S CNT2=CNT2+1 127 . . S WVIEN=$P($P($G(RESULT(CNT)),U),":",2),WVRESULT(CNT2)=$G(WVIEN) 128 . . S WVRESULT(CNT2)=WVRESULT(CNT2)_U_$P($P($G(RESULT(CNT)),U,3),":",2) 129 . I $P($G(RESULT(CNT)),U)["WHPur" D 130 . . S NODE=$G(RESULT(CNT)),PUR=$P($P($G(NODE),U),":",2) 131 . . S CNT1=1,TYPE=$P($G(NODE),U,2) 132 . . I TYPE'[":" D 133 ...S WVNOT(PUR,CNT1)=$P($G(NODE),U,5)_U_$P($G(NODE),U,2)_U_$P($G(NODE),U,3)_U_$P($P($G(NODE),U,4),":",2) 134 ..I TYPE[":" D 135 ...S PIECNT=0 136 ...F X=1:1:$L(TYPE) I $E(TYPE,X)=":" S PIECNT=PIECNT+1 I PIECNT>0 D 137 ....S PRINT="" 138 ....S TYP1=$P($G(TYPE),":",PIECNT) 139 ....I TYP1="L" S PRINT=$P($G(NODE),U,3) 140 ....S WVNOT(PUR,CNT1)=$P($G(NODE),U,5)_U_$G(TYP1)_U_$G(PRINT)_U_$P($P($G(NODE),U,4),":",2),CNT1=CNT1+1 141 ...S PIECNT=PIECNT+1 142 ...S PRINT="" 143 ...S TYP1=$P($G(TYPE),":",PIECNT) 144 ...I TYP1="L" S PRINT=$P($G(NODE),U,3) 145 ...S WVNOT(PUR,CNT1)=$P($G(NODE),U,5)_U_$G(TYP1)_U_$G(PRINT)_U_$P($P($G(NODE),U,4),":",2) 146 K WHMUFIND,WHFIND,WHNAME 147 ;DBIA #4104 148 D NEW^WVRPCNO(.WVRESULT,.WVNOT) 149 Q 150 ; 1 PXRMRPCC ;SLC/PJH - PXRM REMINDER DIALOG ;04/12/2002 2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005 3 ; 4 ACTIVE(ORY,ORREM) ;Check if active dialog exist for reminders 5 ; 6 ; input parameter ORREM is array of reminder ien [.01#811.9] 7 N DDIS,DIEN,OCNT,RIEN,RSTA 8 S OCNT=0,RIEN=0 9 ;Get reminder ien from array 10 F S RIEN=$O(ORREM(RIEN)) Q:'RIEN D 11 .;Dialog ien for reminder 12 .S DIEN=$P($G(^PXD(811.9,RIEN,51)),U),RSTA=0 13 .;Dialog status 14 .I DIEN S DDIS=$P($G(^PXRMD(801.41,DIEN,0)),U,3) 15 .;If dialog and dialog not disabled 16 .I DIEN,DDIS="" S RSTA=1 17 .;Return reminder and if active dialog exists 18 .S OCNT=OCNT+1,ORY(OCNT)=RIEN_U_RSTA 19 Q 20 ; 21 ; 22 DIALOG(ORY,ORREM,DFN) ;Load reminder dialog associated with the reminder 23 ; 24 ; input parameter ORREM - reminder ien [.01,#811.9] 25 ; 26 S RIEN=ORREM 27 N DATA,DIEN 28 S DIEN=$G(^PXD(811.9,ORREM,51)) 29 ; 30 ;Quit if no dialog for this reminder 31 I 'DIEN S ORY(1)="-1^no dialog for this reminder" Q 32 ; 33 ;Check if a reminder dialog and enabled 34 S DATA=$G(^PXRMD(801.41,DIEN,0)) 35 ; 36 I $P(DATA,U,4)'="R" S ORY(1)="-1^reminder dialog invalid" Q 37 ; 38 I $P(DATA,U,3) S ORY(1)="-1^reminder dialog disabled" Q 39 ; 40 ;Load dialog lines into local array 41 D LOAD^PXRMDLL(DIEN,$G(DFN)) 42 Q 43 ; 44 HDR(ORY,ORLOC) ;Progress Note Header by location/service/user 45 N ORSRV,PASS 46 ;S ORSRV=$G(^VA(200,DUZ,5)) I +ORSRV>0 S ORSRV=$P(ORSRV,U) 47 S ORSRV=$$GET1^DIQ(200,DUZ,29,"I") 48 S PASS=DUZ_";VA(200," 49 I +$G(ORLOC) S PASS=PASS_"^LOC.`"_ORLOC 50 I ORSRV>0 S PASS=PASS_"^SRV.`"_+$G(ORSRV) 51 S ORY=$$GET^XPAR(PASS_"^DIV^SYS^PKG","PXRM PROGRESS NOTE HEADERS",1,"Q") 52 Q 53 ; 54 PROMPT(ORY,ORDLG,ORDCUR,ORFTYP) ;Load additional prompts for a dialog element 55 ; 56 ; input parameters 57 ; 58 ; ORDLG - dialog element ien [.01,#801.41] 59 ; ORDCUR - 0 = current, 1 = Historical for taxonomies only 60 ; ORFTYP - finding type (CPT/POV) for taxonomies only 61 ; 62 ; These fields can be found in the output array of DIALOG^PXRMRPCC 63 ; 64 D LOAD^PXRMDLLA(ORDLG,ORDCUR,$G(ORFTYP)) 65 Q 66 ; 67 RES(ORY,ORREM) ; Reminder Resources/Inquiry 68 ; 69 ; input parameter ORREM - reminder ien [.01,#811.9] 70 ; 71 D REMVAR^PXRMINQ(.ORY,ORREM) 72 Q 73 ; 74 MH(ORY,OTEST) ; Mental Health dialog 75 ; 76 ; Input mental health instrument NAME 77 ; 78 N YS,ARRAY S YS("CODE")=OTEST D SHOWALL^YTAPI3(.ARRAY,.YS) ; DBIA #2895 79 ; 80 N FNODE,FSUB,IC,NODE,OCNT,SUB 81 S SUB="ARRAY",OCNT=0 82 F S SUB=$Q(@SUB) Q:SUB="" D 83 .S FSUB=$P($P(SUB,"(",2),")"),FNODE="" 84 .F IC=1:1 S NODE=$P(FSUB,",",IC) Q:NODE="" D 85 ..I $E(NODE)="""" S NODE=$P(NODE,"""",2) 86 ..S $P(FNODE,";",IC)=NODE 87 .Q:FNODE="" 88 .S OCNT=OCNT+1,ORY(OCNT)=FNODE_U_@SUB 89 Q 90 ; 91 MHR(ORY,RESULT,ORES) ; Mental Health score and P/N text 92 ; 93 ; Input MH result IEN and mental health instrument response 94 ; 95 D ^PXRMDLR 96 ; 97 Q 98 ; 99 MHS(ORY,YS) ; Mental Health save response 100 ; 101 ; Input mental health instrument response 102 N ARRAY 103 D SAVEIT^YTAPI1(.ARRAY,.YS) ; DBIA #2893 104 I ARRAY(1)'="[DATA]" S ORY(1)="-1^"_ARRAY(1)_ARRAY(2) 105 I ARRAY(1)="[DATA]" S ORY(1)=ARRAY(1)_ARRAY(2) 106 Q 107 ; 108 MST(ORY,DFN,DGMSTDT,DGMSTSC,DGMSTPR,FTYP,FIEN,RESULT) ; File MST status 109 ;This is obsolete and can be removed when the GUI is changed not 110 ;to use it. 111 Q 112 ; 113 WH(ORY,RESULT) ; 114 N CNT,CNT1,CNT2,NODE,PIECNT,PUR,TYPE,TYP1,WVIEN,WVRESULT,WVNOT,WVPURIEN 115 N PRINT 116 K ^TMP("WV RPT",$J) 117 I '$D(RESULT) Q 118 S (CNT2,WVPURIEN,PUR)=0 119 S CNT=0 F S CNT=$O(RESULT(CNT)) Q:CNT="" D 120 . I $P($G(RESULT(CNT)),U)["WHIEN" D 121 . . S CNT2=CNT2+1 122 . . S WVIEN=$P($P($G(RESULT(CNT)),U),":",2),WVRESULT(CNT2)=$G(WVIEN) 123 . . S WVRESULT(CNT2)=WVRESULT(CNT2)_U_$P($P($G(RESULT(CNT)),U,3),":",2) 124 . I $P($G(RESULT(CNT)),U)["WHPur" D 125 . . S NODE=$G(RESULT(CNT)),PUR=$P($P($G(NODE),U),":",2) 126 . . S CNT1=1,TYPE=$P($G(NODE),U,2) 127 . . I TYPE'[":" D 128 ...S WVNOT(PUR,CNT1)=$P($G(NODE),U,5)_U_$P($G(NODE),U,2)_U_$P($G(NODE),U,3)_U_$P($P($G(NODE),U,4),":",2) 129 ..I TYPE[":" D 130 ...S PIECNT=0 131 ...F X=1:1:$L(TYPE) I $E(TYPE,X)=":" S PIECNT=PIECNT+1 I PIECNT>0 D 132 ....S PRINT="" 133 ....S TYP1=$P($G(TYPE),":",PIECNT) 134 ....I TYP1="L" S PRINT=$P($G(NODE),U,3) 135 ....S WVNOT(PUR,CNT1)=$P($G(NODE),U,5)_U_$G(TYP1)_U_$G(PRINT)_U_$P($P($G(NODE),U,4),":",2),CNT1=CNT1+1 136 ...S PIECNT=PIECNT+1 137 ...S PRINT="" 138 ...S TYP1=$P($G(TYPE),":",PIECNT) 139 ...I TYP1="L" S PRINT=$P($G(NODE),U,3) 140 ...S WVNOT(PUR,CNT1)=$P($G(NODE),U,5)_U_$G(TYP1)_U_$G(PRINT)_U_$P($P($G(NODE),U,4),":",2) 141 K WHMUFIND,WHFIND,WHNAME 142 ;DBIA #4104 143 D NEW^WVRPCNO(.WVRESULT,.WVNOT) 144 Q 145 ;
Note:
See TracChangeset
for help on using the changeset viewer.
