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