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

VENPCCU.m

Go to the documentation of this file. 
  1. VENPCCU ; IHS/OIT/GIS - VEN UTILITIES ; 29 Dec 2009  2:02 PM
  1.  ;;2.6;PCC+;**1,3**;APR 03, 2012;Build 24
  1.  ;
  1.  ;
  1. PAUSE ; EP-PAUSE FOR USER
  1.  Q:$E($G(IOST))'="C"
  1.  Q:$D(ZTQUEUED)!'(IOT["TRM")!$D(IO("S"))
  1.  S DIR(0)="E",DIR("A")="Press the <ENTER> key to continue" D ^DIR K DIR
  1.  W !
  1.  I $D(DIRUT) K DIRUT
  1.  Q
  1.  ;
  1. FILE ; EP-DO FILE^DICN
  1.  K DD,DO
  1.  D FILE^DICN
  1.  K D,D0,D1,DA,DDER,DI,DIADD,DIC,DICR,DIE,DLAYGO,DQ,DR,DINUM
  1.  Q
  1.  ;
  1.  ;
  1. PRV(PIEN) ; EP-CONVERTS FILE 16 IEN TO FILE 200 IEN
  1.  I $G(^DD(9000010.06,.01,0))[($C(68)_"IC(6,") Q $O(^VA(200,"A16",PIEN,0))
  1.  Q PIEN
  1.  ;
  1. CHART(CHART,LIEN) ; EP-GIVEN A LOCATION IEN AND PHS CHART # RETURN THE PATIENT DFN
  1.  I '$D(^AUTTLOC(LIEN,0)) Q ""
  1.  I $G(CHART)="" Q ""
  1.  N DFN,X,%
  1.  F  S %=$E(CHART) Q:%'=0  S CHART=$E(CHART,2,99) ; STRIP LEADING ZEROS
  1.  S DFN=0 F  S DFN=$O(^AUPNPAT("D",CHART,DFN)) Q:'DFN  I $D(^AUPNPAT("D",CHART,DFN,LIEN)) Q
  1.  Q DFN
  1.  ; 
  1. CHOP(TXT,LEN,TAB,CNT) ; EP - CHOP A TXT STRING INTO LINES
  1.  I $L($G(TXT)),$G(LEN)
  1.  E  Q
  1.  S CNT=+$G(CNT),TAB=$G(TAB),SPACE=$E("                  ",1,TAB)
  1.  N PCE,S,X,Y,%
  1.  S S=" "
  1.  F PCE=1:1 S X=$P(TXT,S,1,PCE) D  I '$L(TXT) Q
  1.  . I $L(X)<LEN Q  ; MAX LINE LENGTH IS 70
  1.  . S X=$P(X,S,1,PCE-1)
  1.  . I $L(X)>LEN S X=$E(X,1,LEN) ; FORCE A BREAK IF THERE ARE NO SPACES IN THE LINE
  1.  . S Y=$E(TXT,$L(X)+1,99999)
  1.  . S Y=$$STRIP^VENPCCU(Y)
  1.  . S CNT=CNT+1
  1.  . S TXT=Y,TXT(CNT)=SPACE_X
  1.  . I $L(TXT)>70 Q
  1.  . S CNT=CNT+1
  1.  . S TXT(CNT)=SPACE_TXT,TXT="" ; FINISH IT OFF
  1.  . Q
  1.  Q
  1.  ; 
  1. CONVERT(MN,SS) ; EP-CONVERT A HEADER FILE TO A XXX_HEADER FILE
  1.  N PATH,FILE,REC,%,N,POP
  1.  I '$G(SS) S SS=2
  1.  S PATH=$G(^VEN(7.5,$$CFG^VENPCCU,SS)) I '$L(PATH) Q
  1.  S FILE=MN_"header.txt"
  1.  S POP=$$OPN^VENPCCP(PATH,FILE,"R","R REC") I POP Q
  1.  S %="",N=$L(REC,U) S $P(%,U,N)="" S REC=REC_$C(13,10)_%
  1.  S FILE=MN_"_header.txt"
  1.  S POP=$$OPN^VENPCCP(PATH,FILE,"W","W REC")
  1.  Q
  1.  ; 
  1. GP(FILE) ; EP-RETURNS THE IEN OF THE LOCAL GENERIC PROVIDER
  1.  N CFIGIEN,NAME,DFN
  1.  S FILE=$G(FILE,200)
  1.  S CFIGIEN=$$CFG I 'CFIGIEN Q ""
  1.  S DFN=$P($G(^VEN(7.5,CFIGIEN,0)),U,13)
  1.  I FILE=200 Q DFN
  1.  S NAME=$P($G(^DPT(DFN,0)),U) I '$L(NAME) Q ""
  1.  S %=U_$C(68)_"IC(16)",DFN=$O(@%@("B",NAME,0)) Q DFN
  1.  ; 
  1. CFG() ; EP-RETURN THE CURRENT CONFIGURATION IEN
  1.  N CFIGIEN
  1.  S CFIGIEN=$O(^VEN(7.5,"AC",1,0))
  1.  Q CFIGIEN
  1.  ; 
  1. OS() ; EP-RETURNS THE LOCAL OPERATING SYSTEM
  1.  Q $P($G(^VEN(7.5,+$$CFG^VENPCCU,0)),U,4)
  1.  ; 
  1. VEN() ; EP-M VENDOR
  1.  N % S %=$P($G(^VEN(7.5,+$$CFG^VENPCCU,0)),U,5)
  1.  Q %
  1.  ; 
  1. CLASS(IEN,X) ; EP-FROM DATA DICTIONARY 19707.93
  1.  I X,X>0,X<5
  1.  E  Q ""
  1.  N Y,Z,%
  1.  S Y=$P($G(^VEN(7.93,+$G(IEN),0)),U,8)
  1.  I Y="" Q Y
  1.  S Z=$E(Y)
  1.  S %=X_Z
  1.  Q %
  1.  ; 
  1. STRIP(X) ; EP-STRIP BLANKS OFF BOTH ENDS OF A STRING
  1.  F X=$RE(X),$RE(X) F  Q:$E(X)'=" "  S X=$E(X,2,9999)
  1.  Q X
  1.  ;
  1. PAD(X,LEN) ; EP-PAD RIGHT END OF STRING WITH SPACES TO LENGTH LEN
  1.  N %
  1.  I '$L($G(X)) Q ""
  1.  I '$G(LEN) Q ""
  1.  S %="",$P(%," ",LEN)=""
  1.  S X=X_$E(%,1,(LEN-$L(X)))
  1.  Q X
  1.  ; 
  1. NOW() ; EP-FROM MULTIPLE ROUTINES
  1.  N %,%H,%I,X,D,T
  1.  D NOW^%DTC
  1.  S D=%\1,T=$P(%,".",2),T=$E(T,1,4)
  1.  Q D_"."_T
  1.  ; 
  1. PRV1(DFN) ; EP-CONVERT FILE 200 DFN TO FILE 16 IEN
  1.  Q $P($G(^VA(200,+$G(DFN),0)),U,16)
  1.  ; 
  1. CLASS1(IEN,X) ; EP FROM THE DD.  COMPUTES A TRIGGER VALUE
  1.  I X,X>0,X<5
  1.  E  Q ""
  1.  N Y,Z,%
  1.  S Y=$P($G(^VEN(7.94,+$G(IEN),0)),U,8)
  1.  I Y="" Q Y
  1.  S Z=$E(Y)
  1.  S %=X_Z
  1.  Q %
  1.  ; 
  1. CLASS2(IEN,X) ; EP-FROM THE DD 19707.1.  COMPUTES A TRIGGERED VALUE
  1.  I X,X>0,X<9
  1.  E  Q ""
  1.  N Y,Z
  1.  S Y=$P($G(^VEN(7.1,+$G(IEN),0)),U)
  1.  I Y="" Q Y
  1.  S Z=Y_"."_X
  1.  Q Z
  1.  ; 
  1. DUR(D0) ; EP-FROM DD 19707.2 ; COMPUTES THE CURRENT DURATION OF WAITING TIME
  1.  N %,%I,%H,X,T1,T2
  1.  I '$D(^VEN(7.2,+$G(D0),0)) Q ""
  1.  S X=^VEN(7.2,D0,0)
  1.  S %=$P(X,U,5) I '% Q ""
  1.  S T1=$P(X,U) I 'T1 Q ""
  1.  D NOW^%DTC S T2=%
  1.  Q $$TIME(T1,T2)
  1.  ; 
  1. TIME(T1,T2) ; EP - TIMESTAMP DISPLAY
  1.  N HM1,HM2,H1,H2,M1,M2,XD,XM,XH,DUR,H,M,D,%,D1,D2
  1.  S D1=T1\1,D2=T2\1
  1.  S HM1=$P(T1,".",2),HM2=$P(T2,".",2)
  1.  S H1=$E(HM1,1,2),H2=$E(HM2,1,2)
  1.  S M1=$E(HM1,3,4),M2=$E(HM2,3,4)
  1.  I M2<M1 S M2=M2+60,H2=H2-1
  1.  I H2<H1 S H2=H2+24,D2=D2-1
  1.  S XD=(D2-D1)*(60*24)
  1.  S XH=(H2-H1)*60
  1.  S XM=(M2-M1)
  1.  S DUR=(XD+XH+XM)
  1.  I DUR<60 Q DUR_"m"
  1.  I DUR<(24*60) S H=DUR\60 S M=DUR#60 S %=H_"h" S %=%_" "_M_"m" Q %
  1.  S D=DUR\(60*24) S H=DUR\24 S M=DUR#(60*24)
  1.  Q D_"d "_H_"h "_M_"m"
  1.  ; 
  1. LEN(D0) ; EP-ELAPSED TIME, EXTERNAL FORMAT
  1.  N T1,T2
  1.  S T1=$P($G(^VEN(7.2,+$G(D0),0)),U) I '$L(T1) Q ""
  1.  S T2=$P($G(^VEN(7.2,+$G(D0),0)),U,2) I '$L(T2) Q ""
  1.  Q $$TIME(T1,T2)
  1.  ; 
  1. TESTTCP ; EP-TEST THE TCP SOCKET
  1.  N POP,X,Y
  1. TT1 W !! S DIR(0)="FO^7:15",DIR("A")="Enter the IP address of the Print Server",DIR("?")="Must be a valid IP address" KILL DA D ^DIR KILL DIR
  1.  I $G(Y)?1."^" Q
  1.  I '$L(Y) Q
  1.  S POP=$$OTCP^VENPCCP(Y,5143)
  1.  I POP W !,"Failed to open the TCP socket" Q
  1.  D CTCP^VENPCCP
  1.  W !,"TCP socket opened successfully!"
  1.  G TT1
  1.  ;
  1. AQ(DA,X) ; EP-FROM THE DD TO CREATE A MUMPS XREF FOR VEN QUEUE
  1.  I X,DA
  1.  E  Q
  1.  N Y S Y=$G(^VEN(7.2,+$G(DA),0))
  1.  S ^VEN(7.2,"AQ",($P(Y,U,3)_";"_$P(Y,U,4)_";"_X),DA)=""
  1.  Q
  1.  ;
  1. AQ1(DA) ; EP-FROM THE DD TO DELETE THE AQ XREF FOR VEN QUEUE
  1.  N Y
  1.  S Y=$G(^VEN(7.2,+$G(DA),0))
  1.  K ^VEN(7.2,"AQ",(+$P(Y,U,3)_";"_+$P(Y,U,4)_";"_+$P(Y,U,12)),DA)
  1.  Q
  1.  ; 
  1. CP(DEPTIEN) ; EP-RETURNS THE DEFAULT PROVIDER FOR A GIVEN CLINIC
  1.  N %
  1.  S %=$P($G(^VEN(7.95,+$G(DEPTIEN),2)),U,2)
  1.  Q %
  1.  ;
  1. PGRP(DEPTIEN,HSFLAG,PGRP) ; EP-RETURN THE PRINTER GROUP
  1.  N %
  1.  I $G(HSFLAG),$P($G(^VEN(7.5,+$G(CFIGIEN),0)),U,10) S %=$$MRP I $L(%) Q % ; PRINT HS IN MED RECORDS
  1.  S %=$P($G(^VEN(7.95,DEPTIEN,2)),U,1) S %=$P($G(^VEN(7.4,+%,0)),U)
  1.  I %="",PGRP S %=$P($G(^VEN(7.4,PGRP,0)),U)
  1.  Q %
  1.  ;
  1. ICD(CODE) ; EP - GIVEN AN ICD CODE, RETURN THE ICD9 IEN OR NULL
  1.  ; WORKS WITH BOTH OLD AND NEW "AB" INDEX!
  1.  I '$L($G(CODE)) Q
  1.  N %,STAT,IEN
  1.  S STAT=$D(^ICD9("AB","250.00 "))
  1.  I STAT S CODE=CODE_" "
  1.  S IEN=$O(^ICD9("AB",CODE,0))
  1.  Q IEN
  1.  ; 
  1. MRP() ; EP - RETURN THE MEDICAL RECORDS PRINT GROUP
  1.  N IEN,NAME
  1.  S IEN=$P($G(^VEN(7.95,+$G(DEPTIEN),2)),U,16)
  1.  I 'IEN S IEN=$O(^VEN(7.4,"AC",1,0))
  1.  I 'IEN Q ""
  1.  S NAME=$P($G(^VEN(7.4,IEN,0)),U)
  1.  Q NAME
  1.  ;
  1. SLASH(X) ; EP-PATH VALIDITY CHECKER INPUT TRANSFORM
  1.  I $G(DA)'=$$CFG Q X ; MUST BE PRIMARY CONFIG
  1.  N %,Y,Z,S
  1.  S %=$$OS,S=$S(%:"/",1:"\"),Z=$E($RE(X))
  1.  I S="/" S X=$TR(X,"\",S)
  1.  E  S X=$TR(X,"/",S)
  1.  I Z=S Q X
  1.  I Z?1A Q (X_S)
  1.  Q ""
  1.  ; 
  1. ZOSF(R,L,X1,X2) ; EP-SCHEDULING PKG LINK
  1.  N CMD,TYPE,OSF,S,A,B,C
  1.  S CMD=$C(90),TYPE=$C(73,76,82,83),S=" ",C=S_CMD_$E(TYPE,1)_S
  1.  S OSF=CMD_$E(TYPE,2)_S_R_S_CMD
  1.  I $L(OSF) S OSF=OSF_$E(TYPE,3)_S_L_C
  1.  S A=X1_C_X2_S_CMD,B=$E(TYPE,4)_S_R X (OSF_A_B)
  1.  Q
  1.  ;
  1. WAIT() ; EP-WAIT STATE
  1.  N %
  1.  W "<>"
  1. W1 R %:$G(DTIME,300) E  Q 0
  1.  W $C(13),?79,$C(13)
  1.  I %?1."^" Q 0
  1.  I %?1."?" W "Press the <ENTER> key to keep scrolling or '^' to quit <>" G W1
  1.  Q 1
  1.  ; 
  1. SETPIECE(VAL,STG,DEL,PCE) ; EP-ALTERNATIVE TO MSM'S FLAWED SETPIECE FUNCTION THAT CRASHES WITH VERY LONG STRINGS
  1.  ; INSERT VAL INTO STRING "STG" AT PIECE "PCE" GIVEN DELIMITER "DEL"
  1.  N P1,P2,N
  1.  S N=$L(STG,DEL)
  1.  I N<2 Q STG
  1.  S P1=$P(STG,DEL,1,PCE-1)
  1.  S P2=$P(STG,DEL,PCE+1,N) K STG
  1.  S STG=P1_DEL_VAL_DEL_P2
  1.  Q STG
  1.  ; 
  1.  ; PATCHED BY GIS/OIT 10/15/05 ; PCC+ 2.5 PATCH 1
  1.  N %,H25,PATH
  1.  S PATH=$G(^VEN(7.5,$$CFG,2)),H25=0
  1.  I '$L(PATH) Q "ef"
  1.  S H25=$$FIND^VENPCCP(PATH,"25header.txt")
  1.  S %=$P($G(^VEN(7.41,+$G(DEFEF),0)),U,2)
  1.  I %="ef",H25 Q 25
  1.  I $L(%) Q %
  1.  Q "ef"
  1.  ; 
  1. MAXNARR(DEFEF) ; EP-RETURN THE NAMIMUM LENGTH OF THE DX NARRATIVE ON THIS FORM ; PATCHED BY GIS 1/8/04
  1.  N %
  1.  S %=$P($G(^VEN(7.41,+$G(DEFEF),5)),U,16)
  1.  I %<22 Q 22
  1.  I %>80 W 22
  1.  Q %
  1.  ; 
  1. FVICD(PIEN) ; EP-GIVEN V POV IEN, RETURN THE ICD CODE (OR NULL IF FOREIGN VISIT SCREEN IS APPLIED AND POSITIVE)
  1.  N X,VIEN,LIEN,IIEN,ICD
  1.  S X=$G(^AUPNVPOV(PIEN,0)) I '$L(X) Q ""
  1.  S VIEN=+$P(X,U,3),IIEN=+X,ICD=$P($G(^ICD9(IIEN,0)),U)
  1.  I '$L(ICD) Q ""
  1.  I '$P($G(^VEN(7.41,+$G(DEFEF),5)),U,15) Q ICD ; NO FOREIGN VISIT FILTER IN PLACE
  1.  S LIEN=$P($G(^AUPNVSIT(VIEN,0)),U,6)
  1.  I $G(DUZ(2)),LIEN'=$G(DUZ(2)) Q "" ; NOT A CONFIRMED LOCAL VISIT
  1.  Q ICD ; LOCAL VISIT
  1.  ;
  1. CSTOP(DEPTIEN) ; EP-GIVEN A DEPARTMENT IEN, RETURN THE CLINIC STOP
  1.  Q $P($G(^VEN(7.95,+$G(DEPTIEN),0)),U,4)
  1.  ; 
  1. FHPT W !,$$FHP("25","b1") ; EP - HF MN FOR b25
  1.  Q
  1.  ; 
  1. FHP(MN,MMF) ; EP-GIVEN A HEADER FILE MNEMONIC AND HEADER (OR PIECE), THIS FUNCTION RETURNS THE '^' PIECE (OR HEADER)
  1.  N X,PCE,L,FLD,PATH,FILE,POP
  1.  I '$L(MN) Q ""
  1.  S FILE=MN_"header.txt"
  1.  S PATH=$G(^VEN(7.5,$$CFG,2)) I '$L(PATH) Q ""
  1.  S POP=$$OPN^VENPCCP(PATH,FILE,"R","R X") I POP Q ""
  1.  I MMF=+MMF Q $P(X,U,MMF) ; PIECE TO FIELD
  1.  S L=$L(X,U),FLD=""
  1.  F PCE=1:1:L S Y=$P(X,U,PCE) I Y=MMF Q
  1.  I Y'=MMF Q ""
  1.  Q PCE ; FIELD TO PIECE
  1.  ;
  1. IEN(X) ; EP - RETURN THE IEN TO A SCHEMA FIELD
  1.  Q +$G(X)
  1.  ;