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

TIUMED1.m

Go to the documentation of this file.
  1. TIUMED1 ; BP/AJB - Mobile Elec. Doc ; 4/30/12 7:40am
  1. ;;1.0;TEXT INTEGRATION UTILITIES;**244,257,264,311**;Jun 20, 1997;Build 13
  1. ; ^SC( IA# 10040
  1. ; XPAR IA# 2263
  1. ; XUPARAM IA# 2541
  1. ; XLFSTR IA# 10104
  1. ; GMTSDVR IA# 744
  1. ; %ZISH IA# 2320
  1. ; DGPMDDCF IA# 1246
  1. ;
  1. Q
  1. ACTLOC(TIULOC) ; IA # 10040
  1. N D0,X I +$G(^SC(TIULOC,"OOS")) Q 0
  1. S D0=+$G(^SC(TIULOC,42)) I D0 D WIN^DGPMDDCF Q 'X ; IA # 1246
  1. S X=$G(^SC(TIULOC,"I")) I +X=0 Q 1
  1. I DT>$P(X,U)&($P(X,U,2)=""!(DT<$P(X,U,2))) Q 0
  1. Q 1
  1. CLINLOC(TIUY,TIUF,TIUDIR) ; returns a set of clinics from HOSPITAL LOCATION
  1. N TIUCNT,TIUDT,TIUIEN,TIUQUIT
  1. S TIUCNT=0
  1. F Q:TIUCNT'<44 S TIUF=$O(^SC("B",TIUF),TIUDIR) Q:TIUF="" D ; IA # 10040
  1. . S TIUIEN="" F S TIUIEN=$O(^SC("B",TIUF,TIUIEN),TIUDIR) Q:'TIUIEN D
  1. . . I ($P($G(^SC(TIUIEN,0)),U,3)'="C") Q
  1. . . I '+$$ACTLOC(TIUIEN) Q
  1. . . S TIUCNT=TIUCNT+1,TIUY(TIUCNT)=TIUIEN_"^"_TIUF
  1. Q
  1. GETHS(TIUY,TIUDFN) ; get health summary
  1. N POP,TIUHF,TIUHS,TIULOC,TIUX
  1. S TIUHS=$$GET^XPAR(DUZ_";VA(200,","TIU MED HSTYPE",1,"Q") ; IA # 2263
  1. I '+TIUHS D
  1. . N TIU,TIUDIV,TIUSRV,TIUSYS D USERINFO^XUSRB2(.TIU)
  1. . S TIUDIV=+TIU(3),TIUSRV=$$LU^TIUPS244(49,TIU(5),"X")
  1. . S TIUHS=$$GET^XPAR(TIUSRV_";DIC(49,","TIU MED HSTYPE",1,"Q")
  1. . S:'+TIUHS TIUHS=$$GET^XPAR(TIUDIV_";DIC(4,","TIU MED HSTYPE",1,"Q")
  1. . I '+TIUHS D
  1. . . S TIUSYS=$$KSP^XUPARAM("WHERE") ; IA # 2541
  1. . . S TIUSYS=$$LU^TIUPS244(4.2,TIUSYS)
  1. . . S TIUHS=$$GET^XPAR(TIUSYS_";DIC(4.2,","TIU MED HSTYPE",1,"Q")
  1. S TIUHF=$$DEFDIR^%ZISH("") ; use default directory IA # 2320
  1. I '+TIUHS S ^TMP("TIUMED",$J,0)="No Default Health Summary Selected" M TIUY=^TMP("TIUMED",$J) K ^TMP("TIUMED",$J) Q
  1. S TIULOC=TIUDFN_$J_".DAT"
  1. D OPEN^%ZISH("TIUMED_"_$J,TIUHF,TIULOC,"W")
  1. Q:+POP
  1. U IO
  1. D ENX^GMTSDVR(TIUDFN,TIUHS,0,0) ; IA # 744
  1. D CLOSE^%ZISH("TIUMED_"_$J)
  1. K ^TMP("TIUMED",$J)
  1. I '+$$FTG^%ZISH(TIUHF,TIULOC,$NA(^TMP("TIUMED",$J,0)),3) Q
  1. S TIUX(TIULOC)="" I $$DEL^%ZISH(TIUHF,$NA(TIUX))
  1. M TIUY=^TMP("TIUMED",$J)
  1. K ^TMP("TIUMED",$J)
  1. Q
  1. GETOBJ(TIUY,TIUDFN,TIUOBJ) ; get patient data object
  1. N DFN,TIUX,VA,VADM,VAERR
  1. K ^TMP("TIUMED",$J) S TIUY=$NA(^TMP("TIUMED",$J))
  1. S TIUOBJ="|"_TIUOBJ_"|"
  1. S DFN=$G(TIUDFN) I '+DFN Q
  1. S TIUX=$$BOIL^TIUSRVD(TIUOBJ,"")
  1. I TIUX["~@" S TIUX=$P(TIUX,"~@",2) M @TIUY=@TIUX K @TIUX Q
  1. M @TIUY@(0)=TIUX
  1. Q
  1. GETPATDT(TIUY,TIUDFN,TIUSEC,TIUGHS) ; get patient data
  1. I +$D(TIUDFN)=1,+$G(TIUDFN) S TIUDFN(0)=TIUDFN
  1. N TIULIST
  1. S TIULIST="" F S TIULIST=$O(TIUDFN(TIULIST)) Q:TIULIST="" D
  1. . N TIU,TIUERR
  1. . D FIND^DIC(2,,".01;.02I;.03I;.09","AXQ",$G(TIUDFN(TIULIST)),1,,,,"TIU","TIUERR")
  1. . S TIU("NAME")=$G(TIU("DILIST","ID",1,.01))
  1. . S TIU("SEX")=$G(TIU("DILIST","ID",1,.02))
  1. . S TIU("DOB")=$G(TIU("DILIST","ID",1,.03))
  1. . S TIU("SSN")=$G(TIU("DILIST","ID",1,.09))
  1. . S TIU("SECURITY")=+$$GET1^DIQ(38.1,$G(TIUDFN(TIULIST)),2,"I")
  1. . I '+$G(TIUSEC),+TIU("SECURITY") S (TIU("SEX"),TIU("DOB"),TIU("SSN"))="*SENSITIVE*"
  1. . I +$G(TIUGHS) D GETHS(.TIUY,$G(TIUDFN(TIULIST)))
  1. . S TIUY(TIULIST)=$G(TIUDFN(TIULIST))_U_TIU("NAME")_U_TIU("SEX")_U_TIU("SSN")_U_TIU("DOB")_U_TIU("SECURITY")
  1. Q
  1. LAST5(TIUY,TIUID) ; IA # 3291
  1. D LAST5^ORWPT(.TIUY,TIUID)
  1. Q
  1. LISTALL(TIUY,TIUFROM,TIUDIR) ; IA # 1685
  1. D LISTALL^ORWPT(.TIUY,TIUFROM,TIUDIR)
  1. Q
  1. DELPARM ;
  1. N DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,POP,TIUANS,TIUERR,TIUSYS,X,Y
  1. DCONT K DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,POP,TIUANS,TIUERR,TIUSYS,X,Y
  1. S TIUSYS=$$KSP^XUPARAM("WHERE") ; IA # 2541
  1. S TIUSYS=$$LU^TIUPS244(4.2,TIUSYS)_U_TIUSYS
  1. S DIR(0)="SO^1:User;2:Service;3:Division;4:System"
  1. S DIR("L",1)="Delete a Health Summary for one the following:"
  1. S DIR("L",2)=""
  1. S DIR("L",3)=" 1 User [choose from NEW PERSON]"
  1. S DIR("L",4)=" 2 Service [choose from SERVICE/SECTION]"
  1. S DIR("L",5)=" 3 Division [choose from INSTITUTION]"
  1. S DIR("L")=" 4 System ["_$P(TIUSYS,U,2)_"]"
  1. S DIR("A")="Enter Selection"
  1. W @IOF
  1. D ^DIR Q:$D(DIRUT)
  1. S TIUANS=$S(Y=1:"VA(200,",Y=2:"DIC(49,",Y=3:"DIC(4,",Y=4:"DIC(4.2,")
  1. S DIC(0)="AE",DIC=U_TIUANS
  1. S DIC("A")="Please select a "_$$UP^XLFSTR(Y(0))_": "
  1. I Y'=4 W ! D ^DIC Q:$D(DIRUT)
  1. I +Y'>0 G DCONT
  1. S TIUANS=TIUANS_U_$S(Y=4:TIUSYS,1:Y)
  1. W !!,"Delete the Health Summary for "_$$UP^XLFSTR(Y(0))_" ["_$P(TIUANS,U,3)_"]",!
  1. I '+$$READ^TIUU("YA","Are you sure? ","NO") G DCONT
  1. D DEL^XPAR($P(TIUANS,U,2)_";"_$P(TIUANS,U),"TIU MED HSTYPE")
  1. W !!,"Parameter Deleted.",! I $$READ^TIUU("EA","RETURN to continue...")
  1. D DCONT
  1. Q
  1. PARMEDIT ;
  1. N DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,POP,TIUANS,TIUERR,TIUSYS,X,Y
  1. CONT K DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,POP,TIUANS,TIUERR,TIUSYS,X,Y
  1. S TIUSYS=$$KSP^XUPARAM("WHERE") ; IA # 2541
  1. S TIUSYS=$$LU^TIUPS244(4.2,TIUSYS)_U_TIUSYS
  1. S DIR(0)="SO^1:User;2:Service;3:Division;4:System"
  1. S DIR("L",1)="TIU MED HSTYPE may be set for the following:"
  1. S DIR("L",2)=""
  1. S DIR("L",3)=" 1 User [choose from NEW PERSON]"
  1. S DIR("L",4)=" 2 Service [choose from SERVICE/SECTION]"
  1. S DIR("L",5)=" 3 Division [choose from INSTITUTION]"
  1. S DIR("L")=" 4 System ["_$P(TIUSYS,U,2)_"]"
  1. S DIR("A")="Enter Selection"
  1. W @IOF
  1. D ^DIR Q:$D(DIRUT)
  1. S TIUANS=$S(Y=1:"VA(200,",Y=2:"DIC(49,",Y=3:"DIC(4,",Y=4:"DIC(4.2,")
  1. S DIC(0)="AE",DIC=U_TIUANS
  1. S DIC("A")="Please select a "_$$UP^XLFSTR(Y(0))_": "
  1. I Y'=4 W ! D ^DIC Q:$D(DIRUT)
  1. I +Y'>0 G CONT
  1. S TIUANS=TIUANS_U_$S(Y=4:TIUSYS,1:Y)
  1. S DIC="^GMT(142,",DIC("A")="Enter a HS for "_$$UP^XLFSTR(Y(0))_" ["_$S(Y(0)="System":$P(TIUSYS,U,2),1:$P(TIUANS,U,3))_"]: "
  1. S DIC("B")=$$GET^XPAR($P(TIUANS,U,2)_";"_$P(TIUANS,U),"TIU MED HSTYPE",1,"Q") ; IA # 2263
  1. W ! D ^DIC
  1. ;*264 Update parameter to use IEN.
  1. I +Y>0 D EN^XPAR($P(TIUANS,U,2)_";"_$P(TIUANS,U),"TIU MED HSTYPE",1,"`"_+Y,.TIUERR) ; IA # 2263
  1. G CONT
  1. Q
  1. PATMAN(TIUY) ;
  1. N TIUP S TIUY=0
  1. D OWNSKEY^XUSRB(.TIUP,"TIU MED MANUAL PATIENT") I +TIUP(0) S TIUY=1
  1. D OWNSKEY^XUSRB(.TIUP,"TIU MED MANUAL OVERRIDE") I +TIUP(0) S TIUY=2
  1. Q
  1. PLISTMEM(TIUY,TIULIST) ;
  1. N TIU,TIUDFN,TIUERR,TIUI,TIUJ
  1. S TIUI=$NA(TIU(100.2101))
  1. D GETS^DIQ(100.21,$G(TIULIST),"10*","I","TIU","TIUERR")
  1. S TIUJ="" F S TIUJ=$O(@TIUI@(TIUJ)) Q:'TIUJ S TIUDFN(+TIUJ)=+@TIUI@(TIUJ,.01,"I")
  1. D GETPATDT(.TIUY,.TIUDFN)
  1. Q
  1. PLISTS(TIUY) ;
  1. N TIU,TIUERR,TIUI,TIUJ,TIUX
  1. S TIUI=$NA(TIU("DILIST")),TIUJ=$NA(^OR(100.21))
  1. D FIND^DIC(100.21,,"-.01","AXQ",DUZ,,"C","I $P($G(^OR(100.21,Y,0)),U,2)=""P""",,"TIU")
  1. I '+$G(@TIUI@(0)) Q
  1. S TIUX="" F S TIUX=$O(@TIUI@("2",TIUX)) Q:'+TIUX S TIUY(TIUX)=@TIUI@("2",TIUX)_U_@TIUJ@(@TIUI@("2",TIUX),0)
  1. Q
  1. GUIVER(TIUMEDVER) ; Will retrieve the version number from the TIU MED GUI VERSION parameter
  1. ;Input parameters
  1. ;1. TIUMEDVER Version number from TIU MED GUI VERSION parameter
  1. ;IA# 2263 [Supported] XPAR Utilities
  1. S TIUMEDVER=$$GET^XPAR("SYS","TIU MED GUI VERSION")
  1. Q