- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWPCE.m
r613 r623 1 ORWPCE ; SLC/JM/REV - wrap calls to PCE and AICS;04/01/2003 ;10/11/06 16:052 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,116,173,190,195,215,243**;Dec 17, 1997;Build 242 3 4 5 6 7 8 9 10 VISIT(LST,CLINIC,ORDATE) 11 12 13 14 PROC(LST,CLINIC,ORDATE) 15 16 17 18 19 20 21 22 23 24 25 26 27 28 CPTMODS(LST,ORCPTCOD,ORDATE) 29 30 31 32 33 34 35 36 37 GETMOD(MODINFO,ORMODIEN,ORDATE) 38 39 40 41 42 43 DIAG(LST,CLINIC,ORDATE) 44 45 46 47 IMM(LST,CLINIC) 48 49 50 SK(LST,CLINIC) 51 52 53 HF(LST,CLINIC) 54 55 56 PED(LST,CLINIC) 57 58 59 TRT(LST,CLINIC) 60 61 62 XAM(LST,CLINIC) 63 64 65 ACTPROB(GLST,DFN,ORDATE) 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 SCSEL(VAL,DFN,ATM,LOC,VST) 91 92 ; MSTallow^MSTdflt;HNCallow^HNCdflt;CVAllow^CVDflt;SHADAllow^SHADDflt93 94 95 S VAL=$G(ORX("SC"))_S_$G(ORX("AO"))_S_$G(ORX("IR"))_S_$G(ORX("EC"))_S_$G(ORX("MST"))_S_$G(ORX("HNC"))_S_$G(ORX("CV"))_S_$G(ORX("SHAD"))96 97 SCDIS(LST,DFN) 98 99 100 101 102 103 104 105 106 107 108 CPTREQD(VAL,IEN) 109 110 111 NOTEVSTR(VAL,IEN) 112 113 114 115 116 117 HASVISIT(ORY,IEN,DFN,ORLOC,ORDTE) 118 119 120 121 122 123 124 DELETE(VAL,VSTR,DFN) 125 126 127 128 129 130 131 132 133 134 135 136 137 SAVE(OK,PCELIST,NOTEIEN,ORLOC) 138 139 140 141 142 143 144 145 146 147 148 149 150 LEX(LST,X,APP,ORDATE) 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 K ^TMP("LEXFND",$J),^TMP("LEXHIT",$J),^TMP("LEXSCH",$J)168 169 LEXCODE(VAL,IEN,APP,ORDATE) 170 171 172 173 174 175 176 ADDRES 177 178 179 180 GETSVC(NEWSVC,SVC,LOC,INP) 181 182 183 184 185 186 1 ORWPCE ; SLC/JM/REV - wrap calls to PCE and AICS;04/01/2003 ;07/05/04 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,116,173,190,195,215**;Dec 17, 1997 3 ; 4 ; DBIA 2950 LOOK^LEXA ^TMP("LEXFND",$J) 5 ; DBIA 1609 CONFIG^LEXSET ^TMP("LEXSCH",$J) 6 ; DBIA 1365 DSELECT^GMPLENFM ^TMP("IB",$J) 7 ; DBIA 3991 $$STATCHK^ICDAPIU 8 ; 9 Q 10 VISIT(LST,CLINIC,ORDATE) ; get list of visit types for clinic 11 S:'+$G(ORDATE) ORDATE=DT 12 D GETLST^IBDF18A(CLINIC,"DG SELECT VISIT TYPE CPT PROCEDURES","LST",,,,ORDATE) 13 Q 14 PROC(LST,CLINIC,ORDATE) ; get list of procedures for clinic P12 for CPTMods 15 S:'+$G(ORDATE) ORDATE=DT 16 D GETLST^IBDF18A(CLINIC,"DG SELECT CPT PROCEDURE CODES","LST",,,1,ORDATE) 17 N IDX,MOD,CODES,FIRST S IDX=0 18 F S IDX=$O(LST(IDX)) Q:'+IDX D 19 . I LST(IDX)="" K LST(IDX) Q 20 . S MOD=0,CODES="",FIRST=1 21 . F S MOD=$O(LST(IDX,"MODIFIER",MOD)) Q:(MOD="") D 22 . . I FIRST S FIRST=0 23 . . E S CODES=CODES_";" 24 . . S CODES=CODES_LST(IDX,"MODIFIER",MOD) 25 . K LST(IDX,"MODIFIER") 26 . I 'FIRST S $P(LST(IDX),U,12)=CODES 27 Q 28 CPTMODS(LST,ORCPTCOD,ORDATE) ;Return CPT Modifiers for a CPT Code 29 N ORM,ORIDX,ORI,MODNAME 30 S:'+$G(ORDATE) ORDATE=DT 31 I +($$CODM^ICPTCOD(ORCPTCOD,$NA(ORM),0,ORDATE)),+$D(ORM) D 32 . S ORIDX="",ORI=0 33 . F S ORIDX=$O(ORM(ORIDX)) Q:(ORIDX="") D 34 . . S ORI=ORI+1,MODNAME=$P(ORM(ORIDX),U,1) 35 . . S LST(MODNAME_ORI)=$P(ORM(ORIDX),U,2)_U_MODNAME_U_ORIDX 36 Q 37 GETMOD(MODINFO,ORMODIEN,ORDATE) ;Returns info for a specific CPT Modifier 38 N ORDATA 39 S:'+$G(ORDATE) ORDATE=DT 40 S ORDATA=$$MOD^ICPTMOD(ORMODIEN,"I",ORDATE,1) 41 I +ORDATA>0 S MODINFO=ORMODIEN_U_$P(ORDATA,U,3)_U_$P(ORDATA,U,2) 42 Q 43 DIAG(LST,CLINIC,ORDATE) ; get list of diagnoses for clinic 44 S:'+$G(ORDATE) ORDATE=DT 45 D GETLST^IBDF18A(CLINIC,"DG SELECT ICD-9 DIAGNOSIS CODES","LST",,,,ORDATE) 46 Q 47 IMM(LST,CLINIC) ;get list of immunizations for clinic 48 D GETLST^IBDF18A(CLINIC,"PX SELECT IMMUNIZATIONS","LST") 49 Q 50 SK(LST,CLINIC) ;get list of skin test for clinic 51 D GETLST^IBDF18A(CLINIC,"PX SELECT SKIN TESTS","LST") 52 Q 53 HF(LST,CLINIC) ;get list of health factors for clinic 54 D GETLST^IBDF18A(CLINIC,"PX SELECT HEALTH FACTORS","LST") 55 Q 56 PED(LST,CLINIC) ;get list of education topices for clinic 57 D GETLST^IBDF18A(CLINIC,"PX SELECT EDUCATION TOPICS","LST") 58 Q 59 TRT(LST,CLINIC) ;get list of treatments for clinic 60 D GETLST^IBDF18A(CLINIC,"PX SELECT TREATMENTS","LST") 61 Q 62 XAM(LST,CLINIC) ;get list of exams for clinic 63 D GETLST^IBDF18A(CLINIC,"PX SELECT EXAMS","LST") 64 Q 65 ACTPROB(GLST,DFN,ORDATE) ;get list of patient's active problems 66 K ^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS") 67 S:'+$G(ORDATE) ORDATE=DT 68 D DSELECT^GMPLENFM ;DBIA 1365 69 N ORPROB,ORPROBIX,ORPRCNT 70 S ORPRCNT=0 71 S ORPROBIX=0 72 F S ORPROBIX=$O(^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",ORPROBIX)) Q:'ORPROBIX D ;DBIA 1365 73 . S ORPROB=$P(^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",ORPROBIX),"^",2,3) 74 . I $E(ORPROB,1)="$" S ORPROB=$E(ORPROB,2,255) 75 . I '$D(ORPROB(ORPROB)) D 76 .. S ORPROB(ORPROB)="" 77 .. S ORPRCNT=ORPRCNT+1 78 .. S $P(^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",ORPROBIX),"^",2,3)=ORPROB 79 . E K ^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",ORPROBIX) 80 ; DBIA 10082 NAME: ICD DIAGNOSIS FILE 81 N ORWINDEX,ORITEM 82 S ORWINDEX=0 83 F S ORWINDEX=$O(^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",ORWINDEX)) Q:'ORWINDEX D:$P(^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",ORWINDEX),"^",1)]"" 84 . S ORITEM=^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",ORWINDEX) 85 . I '+$$STATCHK^ICDAPIU($P(ORITEM,"^",3),ORDATE) S $P(ORITEM,"^",11)="#" ;DBIA 3991 86 . S ^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",ORWINDEX)=ORITEM 87 S ^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",0)=ORPRCNT 88 S GLST="^TMP(""IB"","_$J_",""INTERFACES"",""GMP SELECT PATIENT ACTIVE PROBLEMS"")" 89 Q 90 SCSEL(VAL,DFN,ATM,LOC,VST) ; return SC conditions that may be selected 91 ; VAL=SCallow^SCdflt;AOallow^AOdflt;IRallow^IRdflt;ECallow^ECdflt; 92 ; MSTallow^MSTdflt;HNCallow^HNCdflt;CVAllow^CVDflt 93 N ORX,S S S=";" 94 D SCCOND^PXUTLSCC(DFN,ATM,LOC,$G(VST),.ORX) 95 S VAL=$G(ORX("SC"))_S_$G(ORX("AO"))_S_$G(ORX("IR"))_S_$G(ORX("EC"))_S_$G(ORX("MST"))_S_$G(ORX("HNC"))_S_$G(ORX("CV")) 96 Q 97 SCDIS(LST,DFN) ; Return service connected % and rated disabilities 98 N VAEL,VAERR,I,ILST,DIS,SC,X 99 D ELIG^VADPT 100 S LST(1)="Service Connected: "_$S(+VAEL(3):$P(VAEL(3),U,2)_"%",1:"NO") 101 I 'VAEL(4),'$P($G(^DG(391,+VAEL(6),0)),U,2) S LST(2)="NOT A VETERAN." Q 102 S I=0,ILST=1 F S I=$O(^DPT(DFN,.372,I)) Q:'I S X=^(I,0) D 103 . S DIS=$P($G(^DIC(31,+X,0)),U) Q:DIS="" 104 . S SC=$S($P(X,U,3):"SC",$P(X,U,3)']"":"not specified",1:"NSC") 105 . S ILST=ILST+1,LST(ILST)=DIS_" ("_$P(X,U,2)_"% "_SC_")" 106 I ILST=1 S LST(2)="Rated Disabilities: NONE STATED" 107 Q 108 CPTREQD(VAL,IEN) ; return 1 in VAL if note still needs a CPT code 109 S VAL=+$P(^TIU(8925,IEN,0),U,11) 110 Q 111 NOTEVSTR(VAL,IEN) ; return the VSTR^AUTHOR for a note 112 N X0,X12,VISIT 113 S X0=$G(^TIU(8925,+IEN,0)),X12=$G(^(12)),VISIT=$P(X12,U,7) 114 I +VISIT S VAL=$$VSTRBLD^TIUSRVP(VISIT) I 1 115 E S VAL=$P(X12,U,11)_";"_$P(X0,U,7)_";"_$P(X0,U,13) 116 Q 117 HASVISIT(ORY,IEN,DFN,ORLOC,ORDTE) ;Has visit or is stand alone 118 N ORVISIT 119 S ORY=-1 120 I +$G(IEN)>0 S ORVISIT=+$P($G(^TIU(8925,+IEN,0)),U,3) 121 I +$G(ORVISIT)'>0 S ORVISIT=$$GETENC^PXAPI(DFN,ORDTE,ORLOC) 122 I +$G(ORVISIT)>0 S ORY=$$VST2APPT^PXAPI(ORVISIT) 123 Q 124 DELETE(VAL,VSTR,DFN) ; delete PCE info when deleting a note 125 N VISIT,ORCOUNT 126 N ZTIO,ZTRTN,ZTDTH,ZTSAVE,ZTDESC,ZTSYNC,ZTSK 127 I '$D(^TMP("ORWPCE",$J,VSTR)) S VAL=0 Q ; no PCE data saved yet 128 I $P(VSTR,";",3)="H" S VAL=0 Q ; leave inpatient alone 129 I $L($T(DOCCNT^TIUSRVLV))=0 S VAL=0 Q ; leave if no tiu entry point 130 D DOCCNT^TIUSRVLV(.ORCOUNT,DFN,VSTR) ; Do not delete if another 131 I ORCOUNT>0 S VAL=0 Q ; title points to visit 132 S ZTIO="ORW/PXAPI RESOURCE",ZTRTN="DQDEL^ORWPCE1",ZTDTH=$H 133 S (ZTSAVE("VSTR"),ZTSAVE("DFN"))="",ZTDESC="CPRS Delete Note/PCE" 134 S ZTSYNC="ORW"_VSTR 135 D ^%ZTLOAD I '$D(ZTSK) D DQDEL^ORWPCE1 136 Q 137 SAVE(OK,PCELIST,NOTEIEN,ORLOC) ; save PCE information 138 N VSTR,GMPLUSER 139 N ZTIO,ZTRTN,ZTDTH,ZTSAVE,ZTDESC,ZTSYNC,ZTSK 140 S VSTR=$P(PCELIST(1),U,4) K ^TMP("ORWPCE",$J,VSTR) 141 M ^TMP("ORWPCE",$J,VSTR)=PCELIST 142 S GMPLUSER=$$CLINUSER^ORQQPL1(DUZ),NOTEIEN=+$G(NOTEIEN) 143 S ZTIO="ORW/PXAPI RESOURCE",ZTRTN="DQSAVE^ORWPCE1",ZTDTH=$H 144 S ZTSAVE("PCELIST(")="",ZTDESC="Data from CPRS to PCE" 145 S ZTSAVE("GMPLUSER")="",ZTSAVE("NOTEIEN")="",ZTSAVE("DUZ")="" 146 I VSTR'["E" S ZTSYNC="ORW"_VSTR 147 S ZTSAVE("ORLOC")="" 148 D ^%ZTLOAD I '$D(ZTSK) D DQSAVE^ORWPCE1 149 Q 150 LEX(LST,X,APP,ORDATE) ; return list after lexicon lookup 151 N LEX,ILST,I,IEN 152 S:APP="CPT" APP="CHP" ; LEX PATCH 10 153 S:'+$G(ORDATE) ORDATE=DT 154 D CONFIG^LEXSET(APP,APP,ORDATE) ;DBIA 1609 155 I APP="CHP" D 156 . ; Set the filter for CPT only using CS APIs - format is the same as for DIC("S") 157 . S ^TMP("LEXSCH",$J,"FIL",0)="I $L($$CPTONE^LEXU(+Y,$G(ORDATE)))!($L($$CPCONE^LEXU(+Y,$G(ORDATE))))" ;DBIA 1609 158 . ; Set Applications Default Flag (Lexicon can not overwrite filter) 159 . S ^TMP("LEXSCH",$J,"ADF",0)=1 160 D LOOK^LEXA(X,APP,1,"",ORDATE) 161 I '$D(LEX("LIST",1)) S LST(1)="-1^No matches found." Q 162 S LST(1)=LEX("LIST",1),ILST=1 163 S (I,IEN)="" 164 F S I=$O(^TMP("LEXFND",$J,I)) Q:I="" D ;DBIA 2950 165 .F S IEN=$O(^TMP("LEXFND",$J,I,IEN)) Q:IEN="" D 166 ..S ILST=ILST+1,LST(ILST)=IEN_U_^TMP("LEXFND",$J,I,IEN) 167 K ^TMP("LEXFND",$J),^TMP("LEXHIT",$J) 168 Q 169 LEXCODE(VAL,IEN,APP,ORDATE) ; return code for a lexicon entry 170 S VAL="" 171 S:'+$G(ORDATE) ORDATE=DT 172 I APP="ICD" S VAL=$$ICDONE^LEXU(IEN,ORDATE) 173 I APP="CPT"!(APP="CHP") S VAL=$$CPTONE^LEXU(IEN,ORDATE) ; LEX PATCH 10 174 I VAL="",(APP="CHP") S VAL=$$CPCONE^LEXU(IEN,ORDATE) ; LEX PATCH 10 175 Q 176 ADDRES ; Add the ORW/PXAPI RESOURCE device 177 N X 178 S X=$$RES^XUDHSET("ORW/PXAPI RESOURCE",,5,"CPRS to PCE transactions") 179 Q 180 GETSVC(NEWSVC,SVC,LOC,INP) ; Returns the correct Service Connected Category 181 N DSS,ORWSVC 182 S DSS=$P($G(^SC(+LOC,0)),U,7) 183 Q:'+DSS 184 M ORWSVC=SVC 185 S NEWSVC=$$SVC^PXKCO(.ORWSVC,DSS,INP,LOC) ; DBIA #3225 186 Q
Note:
See TracChangeset
for help on using the changeset viewer.
