| 1 | GMPLHS ; SLC/MKB/KER - Extract Prob List Health Summary ; 04/15/2002
|
|---|
| 2 | ;;2.0;Problem List;**22,26**;Aug 25, 1994
|
|---|
| 3 | ;
|
|---|
| 4 | ; External References
|
|---|
| 5 | ; DBIA 3106 ^DIC(49
|
|---|
| 6 | ; DBIA 10060 ^VA(200
|
|---|
| 7 | ; DBIA 10015 EN^DIQ1
|
|---|
| 8 | ;
|
|---|
| 9 | GETLIST(GMPDFN,STATUS) ; Define List
|
|---|
| 10 | N GMPLIST,GMPLVIEW,GMPARAM,GMPTOTAL K ^TMP("GMPLHS",$J) Q:+GMPDFN'>0
|
|---|
| 11 | S GMPARAM("QUIET")=1,GMPARAM("REV")=$P($G(^GMPL(125.99,1,0)),U,5)="R"
|
|---|
| 12 | S GMPLVIEW("ACT")=STATUS,GMPLVIEW("PROV")=0,GMPLVIEW("VIEW")=""
|
|---|
| 13 | D GETPLIST^GMPLMGR1(.GMPLIST,.GMPTOTAL,.GMPLVIEW)
|
|---|
| 14 | BUILD ; Build list for selected patient
|
|---|
| 15 | ; Sets Global Array:
|
|---|
| 16 | ; ^TMP("GMPLHS",$J,STATUS,0)
|
|---|
| 17 | ;
|
|---|
| 18 | ; Piece 1: GMPCNT # of entries extracted
|
|---|
| 19 | ; 2: GMPTOTAL # of entries that exist
|
|---|
| 20 | N IFN,GMPCNT,NUM S (NUM,GMPCNT)=0 F S NUM=$O(GMPLIST(NUM)) Q:NUM'>0 D
|
|---|
| 21 | . S IFN=+GMPLIST(NUM) Q:IFN'>0 D GETPROB(IFN)
|
|---|
| 22 | I $G(GMPCNT)'>0 K ^TMP("GMPLHS",$J) Q
|
|---|
| 23 | S ^TMP("GMPLHS",$J,STATUS,0)=GMPCNT_U_GMPTOTAL
|
|---|
| 24 | Q
|
|---|
| 25 | GETPROB(IFN) ; Get problem data and set it to ^TMP array
|
|---|
| 26 | ; Sets Global Arrays:
|
|---|
| 27 | ; ^TMP("GMPLHS",$J,CNT,0)
|
|---|
| 28 | ; Piece 1: Pointer to ICD9 file #80
|
|---|
| 29 | ; 2: Internal Date Last Modified
|
|---|
| 30 | ; 3: Facility Name
|
|---|
| 31 | ; 4: Internal Date Entered
|
|---|
| 32 | ; 5: Internal Status (A/I/"")
|
|---|
| 33 | ; 6: Internal Date of Onset
|
|---|
| 34 | ; 7: Responsible Provider Name
|
|---|
| 35 | ; 8: Service Name
|
|---|
| 36 | ; 9: Service Abbreviation
|
|---|
| 37 | ; 10: Internal Date Resolved
|
|---|
| 38 | ; 11: Clinic Name
|
|---|
| 39 | ; 12: Internal Date Recorded
|
|---|
| 40 | ; 13: Problem Term (from Lexicon)
|
|---|
| 41 | ; 14: Exposure String (AO/IR/EC/HNC/MST)
|
|---|
| 42 | ;
|
|---|
| 43 | ; ^TMP("GMPLHS",$J,CNT,"N")
|
|---|
| 44 | ; Piece 1: Provider Narrative
|
|---|
| 45 | ;
|
|---|
| 46 | ; ^TMP("GMPLHS",$J,CNT,"IEN")
|
|---|
| 47 | ; Piece 1: Pointer to Problem file 9000011
|
|---|
| 48 | ;
|
|---|
| 49 | N DIC,DIQ,DR,DA,REC,DIAG,LASTMDT,NARR,SITE,ENTDT,STAT,ONSETDT,RPROV
|
|---|
| 50 | N SERV,SERVABB,RESDT,CLIN,RECDT,LEXI,LEX,PG,AO,EXP,HNC,MST,IR,SCS
|
|---|
| 51 | S DIC=9000011,DA=IFN,DIQ="REC(",DIQ(0)="IE"
|
|---|
| 52 | S DR=".01;.03;.05;.06;.08;.12;.13;1.01;1.05;1.06;1.07;1.08;1.09;1.11;1.12;1.13;1.15;1.16"
|
|---|
| 53 | D EN^DIQ1
|
|---|
| 54 | S DIAG=REC(9000011,DA,.01,"I"),LASTMDT=REC(9000011,DA,.03,"I")
|
|---|
| 55 | S NARR=REC(9000011,DA,.05,"E"),SITE=REC(9000011,DA,.06,"E")
|
|---|
| 56 | S ENTDT=REC(9000011,DA,.08,"I"),STAT=REC(9000011,DA,.12,"I")
|
|---|
| 57 | S ONSETDT=REC(9000011,DA,.13,"I")
|
|---|
| 58 | S LEXI=REC(9000011,DA,1.01,"I")
|
|---|
| 59 | S LEX=REC(9000011,DA,1.01,"E")
|
|---|
| 60 | S RPROV=REC(9000011,DA,1.05,"E")
|
|---|
| 61 | S SERV=REC(9000011,DA,1.06,"E")
|
|---|
| 62 | S SERVABB=$$SERV(REC(9000011,DA,1.06,"I"),SERV)
|
|---|
| 63 | S RESDT=REC(9000011,DA,1.07,"I")
|
|---|
| 64 | S CLIN=REC(9000011,DA,1.08,"E")
|
|---|
| 65 | S RECDT=REC(9000011,DA,1.09,"I")
|
|---|
| 66 | S AO=+REC(9000011,DA,1.11,"I")
|
|---|
| 67 | S IR=+REC(9000011,DA,1.12,"I")
|
|---|
| 68 | S PG=+REC(9000011,DA,1.13,"I")
|
|---|
| 69 | S HNC=+REC(9000011,DA,1.15,"I")
|
|---|
| 70 | S MST=+REC(9000011,DA,1.16,"I")
|
|---|
| 71 | K SCS D SCS^GMPLX1(DA,.SCS) S EXP=$G(SCS(1))
|
|---|
| 72 | S GMPCNT=GMPCNT+1,^TMP("GMPLHS",$J,GMPCNT,0)=DIAG_U_LASTMDT_U_SITE_U_ENTDT_U_STAT_U_ONSETDT_U_RPROV_U_SERV_U_SERVABB_U_RESDT_U_CLIN_U_RECDT_U_LEX_U_EXP
|
|---|
| 73 | S ^TMP("GMPLHS",$J,GMPCNT,"N")=NARR,^TMP("GMPLHS",$J,GMPCNT,"IEN")=IFN
|
|---|
| 74 | S:+LEXI>0 ^TMP("GMPLHS",$J,GMPCNT,"L")=LEXI_"^"_LEX
|
|---|
| 75 | D GETCOMM(IFN,GMPCNT)
|
|---|
| 76 | Q
|
|---|
| 77 | GETCOMM(IFN,CNT) ; Get Active Comments for a Note
|
|---|
| 78 | ; Sets Global Array:
|
|---|
| 79 | ; ^TMP("GMPLHS",$J,CNT,"C",LOCATION,NOTE NMBR,0)
|
|---|
| 80 | ;
|
|---|
| 81 | ; Piece 1: Note Narrative
|
|---|
| 82 | ; 2: Internal Date Note Added
|
|---|
| 83 | ; 3; Name of Note's Author
|
|---|
| 84 | ;
|
|---|
| 85 | N IFN2,IFN3,LOC,NODE S LOC=0 Q:$D(^AUPNPROB(IFN,11))'>0 S IFN2=0
|
|---|
| 86 | F S IFN2=$O(^AUPNPROB(IFN,11,IFN2)) Q:IFN2'>0 D
|
|---|
| 87 | . Q:$D(^AUPNPROB(IFN,11,IFN2,11))'>0
|
|---|
| 88 | . S LOC=+$G(^AUPNPROB(IFN,11,IFN2,0)),IFN3=0
|
|---|
| 89 | . F S IFN3=$O(^AUPNPROB(IFN,11,IFN2,11,IFN3)) Q:IFN3'>0 D
|
|---|
| 90 | . . S NODE=$G(^AUPNPROB(IFN,11,IFN2,11,IFN3,0)) Q:$P(NODE,U,4)']""
|
|---|
| 91 | . . S ^TMP("GMPLHS",$J,CNT,"C",LOC,$P(NODE,U),0)=$P(NODE,U,3)_U_$P(NODE,U,5)_U_$P($G(^VA(200,+$P(NODE,U,6),0)),U)
|
|---|
| 92 | Q
|
|---|
| 93 | SERV(X,SERV) ; Returns Service Name Abbreviation
|
|---|
| 94 | N ABBREV S ABBREV=$P($G(^DIC(49,+X,0)),U,2) S:ABBREV="" ABBREV=$E($G(SERV),1,5)
|
|---|
| 95 | Q ABBREV
|
|---|
