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

VIABRPC.m

Go to the documentation of this file.
  1. VIABRPC ;AAC/JMC - VIA RPCs ;04/05/2016
  1. ;;1.0;VISTA INTEGRATION ADAPTER;**7,8,9,12,22,21**;06-FEB-2014;Build 1
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. ; ICR 10090 INSTITUTION FILE (supported)
  1. ; ICR 10048 PACKAGE FILE (#9.4) (supported)
  1. ; ICR 10141 XPDUTL (supported)
  1. ; ICR 3213 XQALSURO (Supported)
  1. ; ICR 2533 DBIA2533 (Controlled)
  1. ; ICR 3119 Consult Default Reason for Request [GETDEF^GMRCDRFR & $$REAF^GMRCDRFR]
  1. ; ICR 2968 Direct access to file 34
  1. ; ICR 2664 OBSERVATION API [$$PT^DGPMOBS] (supported)
  1. ; ICR 1365 DBIA1365 [DSELECT^GMPLENFM] (controlled)
  1. ; ICR 4075 OR CALL TO TIUSRVP [VSTRBLD^TIUSRVP] (private)
  1. ; ICR 3121 Consult Ordering Utilities [$$PROVDX^GMRCUTL1]
  1. ; ICR 1894 DBIA1889-F [GETENC^PXAPI](controlled)
  1. ; ICR 3540 TIUSRVP, Entry Point: FILE [FILE^TIUSRVP] (controlled)
  1. ; ICR 142 DBIA142-A [File #31, field #.01] (controlled)
  1. ; ICR 649 DBIA186-I [File 391, field .02] (controlled)
  1. ; ICR 2348 SERVICE CONNECTED CONDITIONS [SCCOND^PXUTLSCC] (controlled)
  1. ; ICR 1296 DBIA 1296 GETLST~IBDF18A [GETLST^IBDF18A] (Controlled)
  1. ; ICR 6473 ICR6473 - PROSTHETICS SERVICE [Read field #131 of File #123.5] (private)
  1. ; ICR 6663 PXVIMM IMM SHORT LIST [IMMSHORT^PXVRPC4] (controlled)
  1. ; ICR 2429 USE OF LR7OV4 CALLS [SHOW^LR7OV4] (controlled)
  1. ; ICR 3167 3167 [STARTSTP^PSJORPOE]
  1. ; ICR 3771 XUDHGUI [DEVICE^XUDHGUI] (supported)
  1. ; ICR 3540 TIUSRVP, Entry Point: FILE [FILE^TIUSRVP] (controlled)
  1. ; ICR 6478 NOTEVSTR (TIU DOCUMENT File #8925)(private)
  1. ; ICR 4807 API FOR RATED DISABILITIES [RDIS^DGRPDB] (supported)
  1. ; ICR 1995 CPT Code APIs [CODM^ICPTCOD] (supported)
  1. ; ICR 5679 LEXU (ICD-10 UPDATE) [IMPDATE^LEXU] (supported)
  1. ; ICR 2378 DBIA3278 [DSUP^PSOSIGDS] (private)
  1. ; ICR 1889 ADD/EDIT/DELETE PCE DATA SILENTLY [DATA2PCE^PXAPI]
  1. ; ICR 2533 DBIA2533 [DIV4^DIV4^XUSER] (controlled)
  1. ; ICR 5408 CPT/HCPCS Procedure File 81 (supported)
  1. ; ICR 1995 CPT Code APIs - $$CPTD^ICPTCOD (supported)
  1. ;
  1. GETSURR(RESULT,USER) ; surrogate info.
  1. ;RPC VIAB GETSURR
  1. ; get user's surrogate info
  1. I $G(USER)="" S RESULT="" Q
  1. S RESULT=$$GETSURO^XQALSURO(USER) ;ICR(DBIA) #3213
  1. I +RESULT<1 S RESULT=""
  1. Q
  1. SNAME(RET,SID) ; get station/site name
  1. ;RPC VIAB SITENAME
  1. N SIEN
  1. I $G(SID)="" S RET="-1^Missing Station Number or Site ID" Q
  1. S SIEN=$O(^DIC(4,"D",SID,0)) I 'SIEN S RET="-1^No site found for this Station Number or Site ID" Q
  1. ; ICR(DBIA) #10090 (SUPPORTED)
  1. S RET=$$GET1^DIQ(4,SIEN,.01,"E")
  1. Q
  1. USERDIV(RESULT,VIADUZ) ; station IEN^station number^station name^default division
  1. ;RPC GET USER DIVISIONS
  1. K RESULT
  1. N VIADX,VIADR,VIADC
  1. S VIADC=0
  1. D DIV4^XUSER(.VIADR,VIADUZ)
  1. S VIADX=0
  1. F S VIADX=$O(VIADR(VIADX)) Q:'VIADX!($D(RESULT(1))) D
  1. .I VIADR(VIADX)=1 S VIADC=VIADC+1,RESULT(VIADC)=VIADX_"^"_$$GET1^DIQ(4,+VIADX,99)_"^"_$$GET1^DIQ(4,+VIADX,.01,)_"^1" K VIADR(VIADX)
  1. S VIADX=0
  1. F S VIADX=$O(VIADR(VIADX)) Q:'VIADX D
  1. .S VIADC=VIADC+1
  1. .S RESULT(VIADC)=VIADX_"^"_$$GET1^DIQ(4,+VIADX,99)_"^"_$$GET1^DIQ(4,+VIADX,.01)_"^0"
  1. Q
  1. ;
  1. DEFRFREQ(RESULT,VIAIEN,VIADFN,RESOLVE) ;Return default reason for request for service - ICR #3119
  1. ;RPC VIAB DEFAULT REQUEST REASON
  1. ; VIAIEN=pointer to file 123.5
  1. ; VIADFN=patient, if RESOLVE=1
  1. ; RESOLVE=1 to resolve boilerplate, 0 to not resolve
  1. Q:+$G(VIAIEN)=0
  1. I +RESOLVE,(+$G(VIADFN)=0) Q
  1. S RESULT=$NA(^TMP("VIABREQ",$J))
  1. S:$G(RESOLVE)="" RESOLVE=0
  1. D GETDEF^GMRCDRFR(.RESULT,VIAIEN,VIADFN,RESOLVE)
  1. K @RESULT@(0)
  1. Q
  1. ;
  1. EDITDRFR(RESULT,VIAIEN) ; Allow editing of reason for request? - ICR #3119
  1. ;RPC VIAB EDIT DEFAULT REASON
  1. S RESULT=$$REAF^GMRCDRFR(VIAIEN)
  1. Q
  1. ;
  1. RADSRC(RESULT,SRCTYPE) ; return list of available contract/sharing/research sources - ICR #2968
  1. ;RPC VIAB RADSRC
  1. N VIAX
  1. S VIAX=0
  1. F I=1:1 S VIAX=$O(^DIC(34,VIAX)) Q:+VIAX=0 D
  1. . Q:($P(^DIC(34,VIAX,0),U,2)'=SRCTYPE)
  1. . I $D(^DIC(34,VIAX,"I")),(^DIC(34,VIAX,"I")<$$NOW^XLFDT) Q
  1. . S RESULT(I)=VIAX_U_$P(^DIC(34,VIAX,0),U,1)
  1. Q
  1. ;
  1. CURSPE(RESULT,PTDFN) ; Return current treating specialty - ICR #2664
  1. ;RPC VIAB CURSPE
  1. Q:'PTDFN
  1. N SPEC S SPEC=$$PT^DGPMOBS(PTDFN),RESULT=""
  1. I SPEC'<0 S RESULT=$P(SPEC,U,3)_U_$P(SPEC,U,2)_U_$P(SPEC,U) ;name^ien^obs flag
  1. Q
  1. ;
  1. CPTMODS(RESULT,VIACPTCOD,VIADATE) ;Return CPT Modifiers for a CPT Code - ICR #1995
  1. ;RPC VIAB CPTMODS
  1. N VIAM,VIAIDX,VIAI,MODNAME
  1. S:'+$G(VIADATE) VIADATE=DT
  1. I +($$CODM^ICPTCOD(VIACPTCOD,$NA(VIAM),0,VIADATE)),+$D(VIAM) D
  1. . S VIAIDX="",VIAI=0
  1. . F S VIAIDX=$O(VIAM(VIAIDX)) Q:(VIAIDX="") D
  1. . . S VIAI=VIAI+1,MODNAME=$P(VIAM(VIAIDX),U,1)
  1. . . S RESULT(MODNAME_VIAI)=$P(VIAM(VIAIDX),U,2)_U_MODNAME_U_VIAIDX
  1. Q
  1. ;
  1. ACTPROB(RESULT,DFN,VIADATE) ;get list of patient's active problems - ICR #1365
  1. ;RPC VIAB ACTPROB
  1. N VIAPROB,VIAPROBIX,VIAPRCNT,GMPINDT,VIAIMPDT
  1. K ^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS")
  1. S:'+$G(VIADATE) VIADATE=DT
  1. S GMPINDT=VIADATE,VIAIMPDT=$$IMPDATE^LEXU("10D")
  1. D DSELECT^GMPLENFM ;DBIA 1365
  1. S VIAPRCNT=0
  1. S VIAPROBIX=0
  1. F S VIAPROBIX=$O(^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",VIAPROBIX)) Q:'VIAPROBIX D ;DBIA 1365
  1. . I (VIADATE<VIAIMPDT)&($P(^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",VIAPROBIX),"^",14)="10D") K ^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",VIAPROBIX) Q
  1. . S VIAPROB=$P(^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",VIAPROBIX),"^",2,3)
  1. . I $L(VIAPROB)>255 S $P(VIAPROB,U)=$E($P(VIAPROB,U),1,245)
  1. . I $E(VIAPROB,1)="$" S VIAPROB=$E(VIAPROB,2,255)
  1. . I '$D(VIAPROB(VIAPROB)) D
  1. .. S VIAPROB(VIAPROB)=""
  1. .. S VIAPRCNT=VIAPRCNT+1
  1. .. S $P(^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",VIAPROBIX),"^",2,3)=VIAPROB
  1. . E K ^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",VIAPROBIX)
  1. S ^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",0)=VIAPRCNT
  1. S RESULT=$NA(^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS"))
  1. Q
  1. ;
  1. NOTEVSTR(RESULT,IEN) ; return the VSTR^AUTHOR for a note -; ICR#4075
  1. ;RPC VIAB NOTEVSTR
  1. N X0,X12,VISIT
  1. S X0=$G(^TIU(8925,+IEN,0)),X12=$G(^(12)),VISIT=$P(X12,U,7)
  1. I +VISIT S RESULT=$$VSTRBLD^TIUSRVP(VISIT) I 1
  1. E S RESULT=$P(X12,U,11)_";"_$P(X0,U,7)_";"_$P(X0,U,13)
  1. Q
  1. ;
  1. PROVDX(RESULT,VIAIEN) ;Return provisional dx prompting info for service; ICR#3121
  1. ;This RPC is a similar to ORQQCN PROVDX
  1. ;RPC VIAB PROVDX
  1. S RESULT=$$PROVDX^GMRCUTL1($G(VIAIEN))
  1. Q
  1. ;
  1. ISPROSVC(RESULT,GMRCIEN) ; Is this service part of the consults-prosthetics interface? ICR #6473
  1. ;RPC VIAB ISPROSVC
  1. ;This RPC is a similar to ORQQCN ISPROSVC
  1. ;GMRCIEN - IEN of selected service
  1. I $$GET1^DIQ(123.5,+$G(GMRCIEN),131,"I")=1 S RESULT=1
  1. Q
  1. ;
  1. SECVST(RESULT,NOTEIEN,VIADFN,VIAENCDT,VIAHLOC) ; save secondary visit in TIU, if inpatient; ICR#1894,#3540
  1. ;RPC VIAB TIU SECVST
  1. N VIAVST
  1. S RESULT=0
  1. I +$G(NOTEIEN),+$G(VIADFN),+$G(VIAENCDT),$G(VIAHLOC)'="" D ; NOTEIEN only set on inpatient encounters
  1. . S VIAVST=$$GETENC^PXAPI(VIADFN,VIAENCDT,VIAHLOC)
  1. . I +VIAVST>0 D
  1. . . ;I $$GET1^DIQ(8925,NOTEIEN,.03,"I")=VIAVST Q
  1. . . N VIAOK,VIAX
  1. . . S VIAX(1207)=VIAVST
  1. . . D FILE^TIUSRVP(.VIAOK,NOTEIEN,.VIAX,1)
  1. . . M RESULT=VIAOK
  1. Q
  1. ;
  1. SCDIS(RESULT,DFN) ; Return service connected % and rated disabilities; ICR#10061,#649,#4807,#142
  1. ;RPC VIAB SCDIS
  1. ;This RPC is a similar to ORWPCE SCDIS
  1. N VAEL,VAERR,VIARR,I,ILST,DIS,SC,X
  1. D ELIG^VADPT
  1. S RESULT(1)="Service Connected: "_$S(+VAEL(3):$P(VAEL(3),U,2)_"%",1:"NO")
  1. I 'VAEL(4),'$$GET1^DIQ(391,+VAEL(6),.02,"I") S RESULT(2)="NOT A VETERAN." Q
  1. D RDIS^DGRPDB(DFN,.VIARR)
  1. S I=0,ILST=1 F S I=$O(VIARR(I)) Q:'I S X=VIARR(I) D
  1. . S DIS=$$GET1^DIQ(31,+X,.01,"I") Q:DIS=""
  1. . S SC=$S($P(X,U,3):"SC",$P(X,U,3)']"":"not specified",1:"NSC")
  1. . S ILST=ILST+1,RESULT(ILST)=DIS_" ("_$P(X,U,2)_"% "_SC_")"
  1. I ILST=1 S RESULT(2)="Rated Disabilities: NONE STATED"
  1. Q
  1. ;
  1. SCSEL(RESULT,DFN,APPDT,HLOC,VST) ; return SC conditions that maRESULT be selected; ICR#2348
  1. ;RPC VIAB SCSEL
  1. ;This RPC is a similar to ORWPCE SCSEL
  1. ; RESULT=SCallow^SCdflt;AOallow^AOdflt;IRallow^IRdflt;ECallow^ECdflt;
  1. ; MSTallow^MSTdflt;HNCallow^HNCdflt;CVAllow^CVDflt;SHADAllow^SHADDflt
  1. N VIAB,S
  1. S S=";"
  1. D SCCOND^PXUTLSCC(DFN,APPDT,HLOC,$G(VST),.VIAB)
  1. S RESULT=$G(VIAB("SC"))_S_$G(VIAB("AO"))_S_$G(VIAB("IR"))_S_$G(VIAB("EC"))_S_$G(VIAB("MST"))_S_$G(VIAB("HNC"))_S_$G(VIAB("CV"))_S_$G(VIAB("SHAD"))
  1. Q
  1. ;
  1. VISIT(RESULT,CLINIC,VIADATE) ; get list of visit types for clinic; ICR#1296
  1. ;RPC VIAB VISIT
  1. ;This RPC is a similar to ORWPCE VISIT
  1. S:'+$G(VIADATE) VIADATE=DT
  1. D GETLST^IBDF18A(CLINIC,"DG SELECT VISIT TYPE CPT PROCEDURES","RESULT",,,,VIADATE)
  1. Q
  1. ;
  1. IMMTYPE(RESULT,VIACVXS) ;get the list of active immunizations; ICR#6663
  1. ;RPC VIAB GET IMMUNIZATION TYPE
  1. ;Check for CVX codes passed
  1. I $G(VIACVXS) D IMMTYPE2(.RESULT,VIACVXS) Q
  1. ;If no CVX codes, then return full list
  1. N CNT,X,Y,VIARES,VIARY
  1. S CNT=0
  1. D IMMSHORT^PXVRPC4(.VIARES,"A")
  1. S X="" F S X=$O(VIARES(X)) Q:X="" S Y=VIARES(X) I $P(Y,"^")="IMM" S VIARY($P(Y,"^",3)_"^"_$P(Y,"^",2))=""
  1. S X="" F S X=$O(VIARY(X)) Q:X="" S CNT=CNT+1,RESULT(CNT)=$P(X,"^",2)_"^"_$P(X,"^")
  1. Q
  1. ;
  1. IMMTYPE2(RESULT,VIACVXS) ;get one or more active immunizations by CVX code; ICR#6663
  1. ;RPC VIAB GET IMMUNIZATION TYPE
  1. N A,I,II,JJ,CNT,CPTS,X,XX,Y,YY,VIARES,VIARY,VIACVX,VIACPT,ZXX,ZYY,ZZZ,PATH,ZCPT,VIAFND,CPTNAM,DATA,ZCPT2,CPT2,DIWL,DIWR
  1. S CNT=0,X=""
  1. ;just in case, if no CVX code then return list
  1. I '$G(VIACVXS) D IMMTYPE2(.RESULT) Q
  1. F I=1:1:$L(VIACVXS,";") S X=$P(VIACVXS,";",I) D
  1. .Q:X="" ;in case of leading or ending commas
  1. .S VIACVX(X)=""
  1. D IMMSHORT^PXVRPC4(.VIARES,"A")
  1. S XX="" F S XX=$O(VIARES(XX)) Q:XX="" S YY=VIARES(XX) I $P(YY,"^")="IMM",$D(VIACVX($P(YY,"^",4))) D
  1. .K VIACPT
  1. .D GETS^DIQ(9999999.14,$P(YY,"^",2),"3*","I","VIACPT")
  1. .S (VIAFND,JJ,ZZZ,ZYY,ZXX,PATH,ZCPT,ZCPT2,CPTNAM)=""
  1. .;get the first CPT despite what the multiple within the multiple IEN may be
  1. .F S ZXX=$O(VIACPT(9999999.143,ZXX)) Q:ZXX="" F S ZYY=$O(VIACPT(9999999.143,ZXX,ZYY)) Q:ZYY="" D
  1. ..I $G(VIACPT(9999999.143,ZXX,ZYY,"I"))="CPT" S CPT2(ZXX)=""
  1. .K ZCPT S ZCPT=""
  1. .F II=1:1 S PATH=$O(VIACPT(9999999.1431,II_","_PATH)) Q:PATH="" I $D(CPT2($P(PATH,",",2,3)_",")) D
  1. ..I $G(VIACPT(9999999.1431,PATH,.01,"I")) S ZCPT2=VIACPT(9999999.1431,PATH,.01,"I") D
  1. ...;get the CPT description and combine multiple lines into one
  1. ...K DATA S A=$$CPTD^ICPTCOD(ZCPT2,"DATA")
  1. ...; using DIWR=220 to give room for other fields in 256 length
  1. ...S DIWL=1,DIWR=220,ZCPT="" K ^UTILITY($J,"W") F S JJ=$O(DATA(JJ)) Q:JJ="" S X=DATA(JJ) D ^DIWP
  1. ...S J=0 F S J=$O(^UTILITY($J,"W",DIWL,J)) Q:J="" S ZCPT=ZCPT_" "_^UTILITY($J,"W",DIWL,J,0)
  1. ...S ZCPT(ZCPT2)=$E(ZCPT,2,999)
  1. ..K CPTS S (CPTS,ZCPT2)=""
  1. .S (CPTS,ZCPT2)="" F S ZCPT2=$O(ZCPT(ZCPT2)) Q:ZCPT2="" S CPTS=CPTS_";"_ZCPT2_"|"_ZCPT(ZCPT2)
  1. .S VIARY($P(YY,"^",3)_"^"_$P(YY,"^",4)_"^"_$P(YY,"^",2))=$E(CPTS,2,9999)
  1. S X="" F S X=$O(VIARY(X)) Q:X="" S CNT=CNT+1,RESULT(CNT)=$P(X,"^",3)_"^"_$P(X,"^")_"^"_$P(X,"^",2)_"^"_VIARY(X)
  1. K ^UTILITY($J,"W")
  1. Q
  1. ;
  1. IMMCOLL(RESULT) ; Return help screen showing immediate collect times;ICR#-2429
  1. ;RPC VIAB IMMED COLLECT
  1. ;This RPC is a similar to ORWDLR32 IMMED COLLECT
  1. I $G(DUZ(2))="" Q
  1. D SHOW^LR7OV4(DUZ(2),.RESULT)
  1. Q
  1. ;
  1. ADMIN(RESULT,DFN,SCH,OI,LOC,ADMIN) ; return administration time info;ICR-#2843,10040,10035,3167
  1. ;RPC VIAB ADMIN
  1. ;This RPC is a similar to ORWDPS2 ADMIN
  1. ; RESULT: StartText^StartTime^Duration^FirstAdmin
  1. I ($G(OI)="")!($G(LOC)="") Q
  1. S OI=+$$GET1^DIQ(101.43,+OI,2,"I")
  1. S LOC=+$$GET1^DIQ(44,+LOC,42,"I"),RESULT=""
  1. I $L($G(^DPT(DFN,.1))) S RESULT=$$FIRST(DFN,LOC,OI,$G(SCH),"",$G(ADMIN))
  1. Q
  1. ;
  1. FIRST(DFN,WARD,OI,DATA,ORDER,ADMIN) ; -- Return expected first admin time of order;ICR-#3167
  1. N CNT,ORCNT,ORI,J,ORZ,Y,SCH,ORX,TNUM
  1. I '$G(DFN)!'$G(OI) Q ""
  1. S ORCNT=0 F ORI=1:1:$L(DATA,"^") S ORZ=$P(DATA,U,ORI) D Q:$E(ORZ)="T"
  1. .S TNUM=$$NUMCHAR(ORZ,";") Q:TNUM=0
  1. .F CNT=1:1:TNUM D
  1. .. S SCH=$P(ORZ,";",CNT+1) Q:'$L(SCH) S ORCNT=ORCNT+1
  1. .. I ORCNT>1 S ADMIN=""
  1. .. S ORX(ORCNT)=$$STARTSTP^PSJORPOE(DFN,SCH,OI,WARD,$G(ORDER),$G(ADMIN))
  1. S Y=9999999,J=0
  1. F ORI=1:1:ORCNT S ORZ=$P(ORX(ORI),U,4) I ORZ<Y S Y=ORZ,J=ORI ;earliest
  1. S Y=$S(J:ORX(J),1:"")
  1. Q Y
  1. ;
  1. NUMCHAR(STRING,SUB) ;
  1. N CNT,RESULT
  1. S RESULT=0
  1. F CNT=1:1:$L(STRING) I $E(STRING,CNT)=SUB S RESULT=RESULT+1
  1. Q RESULT
  1. ;
  1. DFLTSPLY(RESULT,UPD,SCH,PAT,DRG,OI) ; return days supply given quantity;ICR-#2843,3278
  1. ;RPC VIAB DFLTSPLY
  1. ;This RPC is a similar to ORWDPS1 DFLTSPLY
  1. ; RESULT: default days supply
  1. N VIABX,I,PSOI,TPKG
  1. S VIABX("PATIENT")=$G(PAT)
  1. I $G(DRG) S VIABX("DRUG")=DRG
  1. I $D(OI) D
  1. . S TPKG=$$GET1^DIQ(101.43,+$G(OI),2,"I") Q:TPKG'["PS"
  1. . S PSOI=+TPKG Q:PSOI'>0
  1. . S VIABX("OI")=PSOI
  1. F I=1:1:$L($G(UPD),U)-1 D
  1. . S VIABX("DOSE ORDERED",I)=$P($G(UPD),U,I)
  1. . S VIABX("SCHEDULE",I)=$P($G(SCH),U,I)
  1. D DSUP^PSOSIGDS(.VIABX)
  1. S RESULT=$G(VIABX("DAYS SUPPLY"))
  1. Q
  1. ;
  1. DEVICE(RESULT,FROM,DIR,MARGIN) ; Return a subset of printer entries from the Device file;ICR-#3771
  1. ;RPC VIAB DEVICE
  1. ; -- Return up to 20 entries from the Device file based on Input criteria
  1. ; INPUT
  1. ; FROM : List all printers start from (text to $O from)
  1. ; B (all device with name start *WITH* B)
  1. ; B* (all device with name start *FROM* B)
  1. ; DIR : Ascending order (1) or Descending order (-1) ($O direction)
  1. ; MARGIN - Right margin (e.g, 80, 132 or "80-132")
  1. ;
  1. ; OUTPUT
  1. ; RESULT : By reference local array contains VistA printers based on input criteria
  1. ; RESULT(1..n)=IEN^Name^DisplayName^Location^RMar^PLen
  1. ;
  1. K RESULT
  1. S FROM=$G(FROM)
  1. S DIR=$G(DIR,1)
  1. S MARGIN=$G(MARGIN)
  1. D DEVICE^XUDHGUI(.RESULT,FROM,DIR,MARGIN)
  1. Q
  1. ;
  1. SAVE(OK,PCELIST,NOTEIEN,VIALOC) ; save PCE information
  1. ;INPUTS:
  1. ; PCELIST - LIST OF ENCOUNTER DATA
  1. ; NOTEIEN - TIU NOTE INTERNAL ENTRY NUMBER [Optional]
  1. ; VIALOC - INPATIENT STATION [Optional]
  1. ;OUTPUT:
  1. ; ARRAY with success or error code followed by problems encountered on data elements
  1. ; The array may contain the following values:
  1. ;
  1. ; 1 Indicates success - no errors and processed completely.
  1. ;
  1. ; -1 An error occurred. Data may or may not have been processed depending on nature of data.
  1. ;
  1. ; -2 Indicates that the routine PXAI found an issue with the visit.
  1. ;
  1. ; -3 Indicates that the input parameters were not properly defined.
  1. ;
  1. ; -4 If cannot get a lock on the encounter
  1. ;
  1. ; -5 If there were only warnings
  1. ;
  1. ; Subsequent values will vary depending on findings from DATA2PCE^PXAPI.
  1. ; the following is an example:
  1. ;
  1. ;Example:
  1. ; OK(0)="-1^Missing Required Fields"
  1. ; OK(1)="AO^No error"
  1. ; OK(2)="CV^NULL"
  1. ; OK(3)="EC^No error"
  1. ; OK(4)="HNC"^No error"
  1. ; OK(5)="IR^No error"
  1. ; OK(6)="MST"^No error"
  1. ; OK(7)="SC^Value must be NULL"
  1. ; OK(8)="SHAD^1"
  1. ;
  1. S:$G(VIALOC)="" VIALOC="VISTA INTEGRATION ADAPTER"
  1. N VSTR,GMPLUSER,VOK ;*21 added VOK
  1. N ZTIO,ZTRTN,ZTDTH,ZTSAVE,ZTDESC,ZTSYNC,ZTSK
  1. S VSTR=$P(PCELIST(1),U,4) K ^TMP("VIAPCE",$J,VSTR)
  1. M ^TMP("VIAPCE",$J,VSTR)=PCELIST
  1. S GMPLUSER=$$CLINUSER(DUZ),NOTEIEN=+$G(NOTEIEN)
  1. D DQSAVE^VIABRPC7
  1. M OK=VOK ;*21 changed return to array
  1. Q
  1. ;
  1. CLINUSER(VIADUZ) ;is this a clinical user?
  1. N VIAUSER
  1. S VIAUSER=0
  1. I $D(^XUSEC("ORES",VIADUZ)) S VIAUSER=1
  1. I $D(^XUSEC("ORELSE",VIADUZ)) S VIAUSER=1
  1. I $D(^XUSEC("PROVIDER",VIADUZ)) S VIAUSER=1
  1. Q VIAUSER
  1. ;
  1. GETVSIT(VSTR,DFN) ; lookup a visit
  1. N PKG,SRC,VIAPXAPI,OK,VIAVISIT
  1. S PKG=$O(^DIC(9.4,"B","VISTA INTEGRATION ADAPTER",0))
  1. S SRC="TEXT INTEGRATION UTILITIES"
  1. S VIAPXAPI("ENCOUNTER",1,"ENC D/T")=$P(VSTR,";",2)
  1. S VIAPXAPI("ENCOUNTER",1,"PATIENT")=DFN
  1. S VIAPXAPI("ENCOUNTER",1,"HOS LOC")=+VSTR
  1. S VIAPXAPI("ENCOUNTER",1,"SERVICE CATEGORY")=$P(VSTR,";",3)
  1. S VIAPXAPI("ENCOUNTER",1,"ENCOUNTER TYPE")="P"
  1. S OK=$$DATA2PCE^PXAPI("VIAPXAPI",PKG,SRC,.VIAVISIT)
  1. Q VIAVISIT
  1. ;
  1. PATCH(VAL,X) ; Return 1 if patch X is installed *22
  1. S VAL=$$PATCH^XPDUTL(X)
  1. Q