GMPLHS ; SLC/MKB/KER - Extract Prob List Health Summary ; 04/15/2002
 ;;2.0;Problem List;**22,26**;Aug 25, 1994
 ;
 ; External References
 ;   DBIA  3106  ^DIC(49
 ;   DBIA 10060  ^VA(200
 ;   DBIA 10015  EN^DIQ1
 ;                    
GETLIST(GMPDFN,STATUS) ; Define List 
 N GMPLIST,GMPLVIEW,GMPARAM,GMPTOTAL K ^TMP("GMPLHS",$J) Q:+GMPDFN'>0
 S GMPARAM("QUIET")=1,GMPARAM("REV")=$P($G(^GMPL(125.99,1,0)),U,5)="R"
 S GMPLVIEW("ACT")=STATUS,GMPLVIEW("PROV")=0,GMPLVIEW("VIEW")=""
 D GETPLIST^GMPLMGR1(.GMPLIST,.GMPTOTAL,.GMPLVIEW)
BUILD ; Build list for selected patient
 ;   Sets Global Array:
 ;   ^TMP("GMPLHS",$J,STATUS,0)
 ;                  
 ;   Piece 1:  GMPCNT     # of entries extracted
 ;         2:  GMPTOTAL   # of entries that exist
 N IFN,GMPCNT,NUM S (NUM,GMPCNT)=0 F  S NUM=$O(GMPLIST(NUM)) Q:NUM'>0  D
 . S IFN=+GMPLIST(NUM) Q:IFN'>0  D GETPROB(IFN)
 I $G(GMPCNT)'>0 K ^TMP("GMPLHS",$J) Q
 S ^TMP("GMPLHS",$J,STATUS,0)=GMPCNT_U_GMPTOTAL
 Q
GETPROB(IFN) ; Get problem data and set it to ^TMP array
 ;   Sets Global Arrays:
 ;   ^TMP("GMPLHS",$J,CNT,0)
 ;   Piece 1:  Pointer to ICD9 file #80
 ;         2:  Internal Date Last Modified
 ;         3:  Facility Name
 ;         4:  Internal Date Entered
 ;         5:  Internal Status (A/I/"")
 ;         6:  Internal Date of Onset
 ;         7:  Responsible Provider Name
 ;         8:  Service Name
 ;         9:  Service Abbreviation
 ;        10:  Internal Date Resolved
 ;        11:  Clinic Name
 ;        12:  Internal Date Recorded
 ;        13:  Problem Term (from Lexicon)
 ;        14:  Exposure String (AO/IR/EC/HNC/MST)
 ;                        
 ;   ^TMP("GMPLHS",$J,CNT,"N")
 ;   Piece 1:  Provider Narrative
 ;                   
 ;   ^TMP("GMPLHS",$J,CNT,"IEN")
 ;   Piece 1:  Pointer to Problem file 9000011
 ;                   
 N DIC,DIQ,DR,DA,REC,DIAG,LASTMDT,NARR,SITE,ENTDT,STAT,ONSETDT,RPROV
 N SERV,SERVABB,RESDT,CLIN,RECDT,LEXI,LEX,PG,AO,EXP,HNC,MST,IR,SCS
 S DIC=9000011,DA=IFN,DIQ="REC(",DIQ(0)="IE"
 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"
 D EN^DIQ1
 S DIAG=REC(9000011,DA,.01,"I"),LASTMDT=REC(9000011,DA,.03,"I")
 S NARR=REC(9000011,DA,.05,"E"),SITE=REC(9000011,DA,.06,"E")
 S ENTDT=REC(9000011,DA,.08,"I"),STAT=REC(9000011,DA,.12,"I")
 S ONSETDT=REC(9000011,DA,.13,"I")
 S LEXI=REC(9000011,DA,1.01,"I")
 S LEX=REC(9000011,DA,1.01,"E")
 S RPROV=REC(9000011,DA,1.05,"E")
 S SERV=REC(9000011,DA,1.06,"E")
 S SERVABB=$$SERV(REC(9000011,DA,1.06,"I"),SERV)
 S RESDT=REC(9000011,DA,1.07,"I")
 S CLIN=REC(9000011,DA,1.08,"E")
 S RECDT=REC(9000011,DA,1.09,"I")
 S AO=+REC(9000011,DA,1.11,"I")
 S IR=+REC(9000011,DA,1.12,"I")
 S PG=+REC(9000011,DA,1.13,"I")
 S HNC=+REC(9000011,DA,1.15,"I")
 S MST=+REC(9000011,DA,1.16,"I")
 K SCS D SCS^GMPLX1(DA,.SCS) S EXP=$G(SCS(1))
 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
 S ^TMP("GMPLHS",$J,GMPCNT,"N")=NARR,^TMP("GMPLHS",$J,GMPCNT,"IEN")=IFN
 S:+LEXI>0 ^TMP("GMPLHS",$J,GMPCNT,"L")=LEXI_"^"_LEX
 D GETCOMM(IFN,GMPCNT)
 Q
GETCOMM(IFN,CNT) ; Get Active Comments for a Note
 ;   Sets Global Array:
 ;   ^TMP("GMPLHS",$J,CNT,"C",LOCATION,NOTE NMBR,0)
 ;                     
 ;   Piece 1:  Note Narrative
 ;         2:  Internal Date Note Added 
 ;         3;  Name of Note's Author 
 ;                        
 N IFN2,IFN3,LOC,NODE S LOC=0 Q:$D(^AUPNPROB(IFN,11))'>0  S IFN2=0
 F  S IFN2=$O(^AUPNPROB(IFN,11,IFN2)) Q:IFN2'>0  D
 . Q:$D(^AUPNPROB(IFN,11,IFN2,11))'>0
 . S LOC=+$G(^AUPNPROB(IFN,11,IFN2,0)),IFN3=0
 . F  S IFN3=$O(^AUPNPROB(IFN,11,IFN2,11,IFN3)) Q:IFN3'>0  D
 . . S NODE=$G(^AUPNPROB(IFN,11,IFN2,11,IFN3,0)) Q:$P(NODE,U,4)']""
 . . 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)
 Q
SERV(X,SERV) ; Returns Service Name Abbreviation
 N ABBREV S ABBREV=$P($G(^DIC(49,+X,0)),U,2) S:ABBREV="" ABBREV=$E($G(SERV),1,5)
 Q ABBREV