VENPCC10 ; IHS/OIT/GIS - CREATE THE PCC+ ENCOUNTER FORM AND HEALTH SUMMARY ;
;;2.6;PCC+;;NOV 12, 2007
;
; POINTS TO NEW DATA EXTRACTION METHODS FOR VER 2.2 AND 2.5
; PATCH 4 INCLUDES SUPPORT FOR LABEL PRINTERS
;
PRINT(VISIT,VCN,DEPTIEN,PRV,DEFEF,DEFHS,APPT,VARS,EXT) ; EP-PRINT ENCOUNTER FORMS
; VISIT=visit ien, VCN=visit control id, PRV=providerien, DEFEF=default enc form IEN, DEFHS=default health summary IEN
N X S X="MERR^VENPCC1",@^%ZOSF("TRAP") ; SET M ERROR TRAP FOR THIS BACKGROUND PROCESS
I $L($G(VARS)) S U="^" D UNPACK(VARS) K VARS
I $D(^VA(200,+$G(PRV),0)),$D(^VEN(7.95,+$G(DEPTIEN),0))
E Q
I $G(JOB),'$G(MOJOFLAG) S %=$NA(^TMP("VEN MON")),@%@(JOB)="Monitoring the process...." H 3
NEW N %,%1,%DT,%HELP,%Q,%T,%Y,CFIGIEN,DATE,DFN,ERR,PATH2,PIEN,POP
N STOP,TMP,UID,X,Y,MSG,FFIEN,FCIEN,PEIEN,VER25,HDR25,LPFLAG,FCIEN
GO I '$D(VENDEBUG),'$D(^TMP("VEN TASK")) X ("J"_" ^VENPCCP") ; IF NECESSARY, START THE PRINT DEAMON
I VISIT[U S DFN=$P(VISIT,U,2),DATE=$P(VISIT,U,3),VISIT=$P(VISIT,U) N NOVISIT S NOVISIT=1 G CFG
S X=$G(^AUPNVSIT(VISIT,0)) I X="" D ERR1^VENPCC1 Q
S DATE=+X,DFN=$P(X,U,5)
I 'DATE D ERR3^VENPCC1 Q
I $G(VENDEMO) D NOW^%DTC S DATE=% K %,%H,%I
I '$D(^AUPNPAT(DFN)) D ERR3^VENPCC1 Q
S X=$G(^VEN(7.95,+$G(DEPTIEN),5)) I $P(X,U,3),$P(X,U,2),+X S LPFLAG=$P(X,U,1,2) ; LABEL PRINTER FLAG
BEF I $G(DEFEF),$P($G(^VEN(7.41,DEFEF,0)),U,13) D ERR11^VENPCC1 Q ; ENCOUNTER FORM TEMPORARILY BLOCKED
CFG S CFIGIEN=$$CFG^VENPCCU I 'CFIGIEN D ERR8^VENPCC1 Q
I $G(HSONLY),'$G(OGFLAG),'$G(LPFLAG) X ("I 0") G HS ; JUST PRINT HS - NOTHING MORE
EF S TMP="^TMP(""VEN PRNT"",$J)" K @TMP,STOP
S VER25=$P($G(^VEN(7.5,CFIGIEN,13)),U) ; NO HEADER FILE RED'Q IN VER 2.5
S HDR25=($P($G(^VEN(7.41,+$G(DEFEF),0)),U,2)=25)
I $D(DEMODATA) D HEAD25 ; IN VERSION 25, ONLY NEED TO SET TMP(9) GLOBAL IF IN DEMODATA MODE
I 'VER25,'$D(DEMODATA) D HEAD I $D(STOP) D ERR10^VENPCC1 Q ; TEMPORARY HEADER GLOBAL
D DEMO^VENPCC1A(PRV,DFN,VCN,VISIT,DEPTIEN,$G(APPT)) I $G(STOP) D ERR5^VENPCC1 Q ; DEMOPGRAPHICS
D SPEC^VENPCC1A(DFN) ; REPRO HX
D DX^VENPCC1G(PRV,DFN,DEFEF,DEPTIEN) I $G(STOP) D ERR6^VENPCC1 Q ; DUAL CODES NEW VERSION
D PROB^VENPCC1H(DFN) ; PROBLEMS AND POVS FOR VER 2.5
D MED^VENPCC1H(PRV,DFN) I $G(STOP) D ERR6^VENPCC1 Q ; VER 2.2 EXTENSION
I $L($G(EXT)) D EXT^VENPCC1B(EXT) ; PROCESS EXTERNAL DATA
D HDR(DEPTIEN) ; TEMPLATE HEADER
D SYS(DFN,+$G(DEFEF)) ; IMMUNIZATIONS, ORDRABLES AND REMINDERS
D ALLERG^VENPCC1C(DFN) ; ALLERGIES
D HX^VENPCC1F(DFN,DEFEF) ; HX OF SURG, FAMILY HX, PERSONAL HX, PODIATRY HX
N SPECHOLD I $D(^VEN(7.62,"AB",DEFEF)) D SPEC^VENPCC1C(DFN,DEFEF) ; LINK TO OCX OBJECTS ON PEDS FORM
S %=$G(^VEN(7.41,+$G(DEFEF),4)) I $L(%) X ("D "_%_"(DFN)") ; SPECIAL DATA MINING CODE FOR THIS TEMPLATE
V22 I $L($T(VER22^VENPCC1G)) D VER22^VENPCC1G(DFN,PRV,VISIT,DEFEF,DEPTIEN) ; UPDATED VER 2.2 EXTENSIONS
V25 I $L($T(VER25^VENPCC1L)) D VER25^VENPCC1L(DFN,PRV,VISIT,DEFEF,DEPTIEN) ; VER 2.5 EXTENSIONS
ANMC I DUZ(2)=1665,$L($T(^VENPCCAK)) D ^VENPCCAK(DFN,DEFEF) ; CUSTOM PCC+ CODE FOR ALASKA
FORM I $P($G(^VEN(7.41,+$G(DEFEF),21)),U),$L($T(FORM^VENPCC1S)) D FORM^VENPCC1S(DFN,VISIT,DEFEF) ; COMPONENT FRAMEWORK DATA
MOJO I $D(MOJOFLAG),$L($T(MOJODATA^VENPCCW)) D Q ; SPECIAL EXTENSIONS FOR MOJO (VER 3.0)
. S @TMP@(1,"u100")=$P($G(^VEN(7.46,+$G(DEFEF),0)),U,2) I @TMP@(1,"u100")="" Q ; NEW WAY TO GET THE FID FROM THE MOJO FORM FILE
. D MOJODATA^VENPCCW ; OUTPUTS DATA DIRECTLY TO MOJO ADO ARRAY
. Q
I $G(HSONLY),$G(OGFLAG) S OGONLY=1 D TXT^VENPCC1(DFN) K OGONLY,OGFLAG,@TMP X ("I 0") G HS ; HS ONLY WITH OUTGUIDE
DATA D TXT^VENPCC1(DFN) I $D(STOP) Q ; BUILD THE DATA FILE FOR THE CURRENT TEMPLATE
K @TMP
I $G(EFONLY)!($G(OGONLY))
HS E D HS^VENPCC2A(DFN,DEFHS,VISIT,DEPTIEN) ; BUILD THE HEALTH SUMMARY DATA FILE
I $G(JOB) K ^TMP("VEN MON",JOB)
Q
;
UNPACK(VARS) ; EP-FOR UNPACKING THE LOCAL VARIABLE LIST
I '$L($G(DUZ(0))) S %=$C(68,85,90),@%@(0)=$C(64)
N I,X,Y,%
F I=1:1:$L(VARS,U) S %=$P(VARS,U,I) I $L(%) S X=$P(%,"=",1),Y=$P(%,"=",2,99) X "S "_X_"="""_Y_""""
Q
;
HEAD ; EP - GET HEADER FILE
; TRADITIONAL WAY TO BUILD THE HEADER ARRAY
NEW F,I,X,Y,%
S PATH2=$G(^VEN(7.5,CFIGIEN,2))
I PATH2="" S STOP=1 D ERR7^VENPCC1 Q
S %=$$HEADER^VENPCCU(+$G(DEFEF))
S F=%_"header.txt"
S POP=$$OPN^VENPCCP(PATH2,F,"R","R X")
I POP S STOP=1 Q
F I=1:1:$L(X,U) S Y=$P(X,U,I),@TMP@(9,I)=Y
Q
;
HEAD25 ; EP - MAKE HEADER GLOBAL FOR VERSION 25
N HGIEN,HIEN,HDR,MN,CNT
S HGIEN=$O(^VEN(7.49,"B","25",0)) I 'HGIEN Q
S HIEN=0,CNT=0
F S HIEN=$O(^VEN(7.49,HGIEN,1,HIEN)) Q:'HIEN D
. S MN=$G(^VEN(7.49,HGIEN,1,HIEN,0)) I '$L(MN) Q
. S CNT=CNT+1
. S @TMP@(9,CNT)=MN
. Q
Q
;
HDR(DEPTIEN) ; EP - HEADER LINES
NEW %,I,X
S X=$P($G(^VEN(7.95,DEPTIEN,0)),U) S %=$P($G(^(0)),U,4)
I % S %=$P($G(^DIC(40.7,%,0)),U,2) I $L(%) S X=X_" "_"("_%_")"
S @TMP@(1,"hdr")=X
Q
;
MRP() ; EP-RETURN THE MEDICAL RECORDS PRINTER GROUP
N IEN,NAME
S IEN=$P($G(^VEN(7.95,+$G(DEPTIEN),2)),U,16)
I 'IEN S IEN=$O(^VEN(7.4,"AC",1,0)) I 'IEN Q ""
S NAME=$P($G(^VEN(7.4,IEN,0)),U)
Q NAME
;
SYS(DFN,DEFEF) ; EP-NEW SYSTEM PREFERENCES
I '$D(^DPT(DFN,0)) Q
I '$D(^VEN(7.41,+$G(DEFEF),0)) Q
N MIEN,TYPE,MMF,PCE,CLASS,SS,HIEN,OSET,NEWSURV,NEWIMM
S CLASS=$$CLASS^VENPCC1C(DFN) I 'CLASS Q
S NEWSURV=0 I $P($G(^VEN(7.41,+$G(DEFEF),5)),U,1) S NEWSURV=1 ; USE NEW SURVEILLANCE LIST
S NEWIMM=0 X "I $L($T(IMMHX^BIRPC)),$L($T(BI^APCHS11C)),$$BI^APCHS11C S NEWIMM=1" ; USE IMMUNIZATION PKG 7.0
CHKLST I $O(^VEN(7.41,+$G(DEFEF),17,0)),$L($T(POP^VENPCCC)),$P($G(^VEN(7.41,DEFEF,0)),U,17) D POP^VENPCCC(DEFEF,DFN) G TICK ; NEW CHECKLIST, VER 2.5
ORD S OSET=$$OSET^VENPCC1C(+$G(DEFEF)),SS=7.93 ; CHECK ORDERABLES FILE AND GET ALL ORDERABLES FOR THIS DEMOG GRP
S HIEN=0 F S HIEN=$O(^VEN(7.42,"AS",1,HIEN)) Q:'HIEN D ; ONLY MM FIELDS FOR ORDERABLES ARE CHECKED
. S MMF=$P($G(^VEN(7.42,HIEN,0)),U) I '$L(MMF) Q ; GET MAIL MERGE FIELD NAME
. S MIEN=0
OSET . I $G(OSET) D Q ; IF ORDER SETS ARE DEFINED
.. F S MIEN=$O(^VEN(7.93,"AS",OSET,MMF,MIEN)) Q:'MIEN I $$XSET^VENPCC1C(SS,DFN,MIEN,MMF,CLASS,DEFEF) Q ; FIND MM FIELD THAT MATCHES THE PATIENTS CLASS AND ASSIGN VALUE
.. Q
NOOSET .. ; IF ORDER SETS NOT DEFINED
. F S MIEN=$O(^VEN(7.93,"C",MMF,MIEN)) Q:'MIEN I $$XSET^VENPCC1C(SS,DFN,MIEN,MMF,CLASS,DEFEF) Q ; FIND MM FIELD THAT MATCHES THE PATIENTS CLASS AND ASSIGN VALUE
. Q
TICK S SS=7.94 ; CHECK TICKLER FILE
ROS S MMF="x" ; GET ROS DATA
F S MMF=$O(^VEN(7.94,"C",MMF)) Q:MMF'["x" D ; L0OP THROUGH ALL THE "x" MAIL MERGE FIELDS IN TICKLER FILE
. S MIEN=0
. F S MIEN=$O(^VEN(7.94,"C",MMF,MIEN)) Q:'MIEN I $$XSET^VENPCC1C(SS,DFN,MIEN,MMF,CLASS,DEFEF) Q ; FIND MM FIELD THAT MATCHES THE PATIENTS CLASS AND ASSIGN VALUE
. Q
SURV ; GET HEALTH MAINT REMINDER DATA
I 'NEWSURV,'NEWIMM D OLDSURV Q ; OLD SURVEILLANCE METHOD
I NEWSURV,NEWIMM D NEWSURV,NEWIMM Q ; NEW SURVEILLANCE METHODS
D OLDSURV
I NEWIMM D IF^VENPCC1C Q
D ARR^VENPCC1E(+$G(DFN))
Q
;
OLDSURV S MMF="h" ; GET HEALTH MAINT REMINDER DATA THE OLD WAY
F S MMF=$O(^VEN(7.94,"C",MMF)) Q:MMF'["h" D ; L0OP THROUGH ALL THE "h" MAIL MERGE FIELDS IN TICKLER FILE
. S MIEN=0
. F S MIEN=$O(^VEN(7.94,"C",MMF,MIEN)) Q:'MIEN I $$XSET^VENPCC1C(SS,DFN,MIEN,MMF,CLASS,DEFEF) Q ; FIND MM FIELD THAT MATCHES THE PATIENTS CLASS AND ASSIGN VALUE
. Q
Q
;
NEWSURV ; EP - NEW METHOD FOR GETTING HEALTH MAINT REMINDER DATA ; h26-h50
D ARR^VENPCC1E(+$G(DFN))
Q
;
NEWIMM ; EP - NEW METHOD FOR GETTING IMM HX ; h9-h25
D IF^VENPCC1C
Q
;
VENPCC10 ; IHS/OIT/GIS - CREATE THE PCC+ ENCOUNTER FORM AND HEALTH SUMMARY ;
+1 ;;2.6;PCC+;;NOV 12, 2007
+2 ;
+3 ; POINTS TO NEW DATA EXTRACTION METHODS FOR VER 2.2 AND 2.5
+4 ; PATCH 4 INCLUDES SUPPORT FOR LABEL PRINTERS
+5 ;
PRINT(VISIT,VCN,DEPTIEN,PRV,DEFEF,DEFHS,APPT,VARS,EXT) ; EP-PRINT ENCOUNTER FORMS
+1 ; VISIT=visit ien, VCN=visit control id, PRV=providerien, DEFEF=default enc form IEN, DEFHS=default health summary IEN
+2 ; SET M ERROR TRAP FOR THIS BACKGROUND PROCESS
NEW X
SET X="MERR^VENPCC1"
SET @^%ZOSF("TRAP")
+3 IF $LENGTH($GET(VARS))
SET U="^"
DO UNPACK(VARS)
KILL VARS
+4 IF $DATA(^VA(200,+$GET(PRV),0))
IF $DATA(^VEN(7.95,+$GET(DEPTIEN),0))
+5 IF '$TEST
QUIT
+6 IF $GET(JOB)
IF '$GET(MOJOFLAG)
SET %=$NAME(^TMP("VEN MON"))
SET @%@(JOB)="Monitoring the process...."
HANG 3
NEW NEW %,%1,%DT,%HELP,%Q,%T,%Y,CFIGIEN,DATE,DFN,ERR,PATH2,PIEN,POP
+1 NEW STOP,TMP,UID,X,Y,MSG,FFIEN,FCIEN,PEIEN,VER25,HDR25,LPFLAG,FCIEN
GO ; IF NECESSARY, START THE PRINT DEAMON
IF '$DATA(VENDEBUG)
IF '$DATA(^TMP("VEN TASK"))
XECUTE ("J"_" ^VENPCCP")
+1 IF VISIT[U
SET DFN=$PIECE(VISIT,U,2)
SET DATE=$PIECE(VISIT,U,3)
SET VISIT=$PIECE(VISIT,U)
NEW NOVISIT
SET NOVISIT=1
GOTO CFG
+2 SET X=$GET(^AUPNVSIT(VISIT,0))
IF X=""
DO ERR1^VENPCC1
QUIT
+3 SET DATE=+X
SET DFN=$PIECE(X,U,5)
+4 IF 'DATE
DO ERR3^VENPCC1
QUIT
+5 IF $GET(VENDEMO)
DO NOW^%DTC
SET DATE=%
KILL %,%H,%I
+6 IF '$DATA(^AUPNPAT(DFN))
DO ERR3^VENPCC1
QUIT
+7 ; LABEL PRINTER FLAG
SET X=$GET(^VEN(7.95,+$GET(DEPTIEN),5))
IF $PIECE(X,U,3)
IF $PIECE(X,U,2)
IF +X
SET LPFLAG=$PIECE(X,U,1,2)
BEF ; ENCOUNTER FORM TEMPORARILY BLOCKED
IF $GET(DEFEF)
IF $PIECE($GET(^VEN(7.41,DEFEF,0)),U,13)
DO ERR11^VENPCC1
QUIT
CFG SET CFIGIEN=$$CFG^VENPCCU
IF 'CFIGIEN
DO ERR8^VENPCC1
QUIT
+1 ; JUST PRINT HS - NOTHING MORE
IF $GET(HSONLY)
IF '$GET(OGFLAG)
IF '$GET(LPFLAG)
XECUTE ("I 0")
GOTO HS
EF SET TMP="^TMP(""VEN PRNT"",$J)"
KILL @TMP,STOP
+1 ; NO HEADER FILE RED'Q IN VER 2.5
SET VER25=$PIECE($GET(^VEN(7.5,CFIGIEN,13)),U)
+2 SET HDR25=($PIECE($GET(^VEN(7.41,+$GET(DEFEF),0)),U,2)=25)
+3 ; IN VERSION 25, ONLY NEED TO SET TMP(9) GLOBAL IF IN DEMODATA MODE
IF $DATA(DEMODATA)
DO HEAD25
+4 ; TEMPORARY HEADER GLOBAL
IF 'VER25
IF '$DATA(DEMODATA)
DO HEAD
IF $DATA(STOP)
DO ERR10^VENPCC1
QUIT
+5 ; DEMOPGRAPHICS
DO DEMO^VENPCC1A(PRV,DFN,VCN,VISIT,DEPTIEN,$GET(APPT))
IF $GET(STOP)
DO ERR5^VENPCC1
QUIT
+6 ; REPRO HX
DO SPEC^VENPCC1A(DFN)
+7 ; DUAL CODES NEW VERSION
DO DX^VENPCC1G(PRV,DFN,DEFEF,DEPTIEN)
IF $GET(STOP)
DO ERR6^VENPCC1
QUIT
+8 ; PROBLEMS AND POVS FOR VER 2.5
DO PROB^VENPCC1H(DFN)
+9 ; VER 2.2 EXTENSION
DO MED^VENPCC1H(PRV,DFN)
IF $GET(STOP)
DO ERR6^VENPCC1
QUIT
+10 ; PROCESS EXTERNAL DATA
IF $LENGTH($GET(EXT))
DO EXT^VENPCC1B(EXT)
+11 ; TEMPLATE HEADER
DO HDR(DEPTIEN)
+12 ; IMMUNIZATIONS, ORDRABLES AND REMINDERS
DO SYS(DFN,+$GET(DEFEF))
+13 ; ALLERGIES
DO ALLERG^VENPCC1C(DFN)
+14 ; HX OF SURG, FAMILY HX, PERSONAL HX, PODIATRY HX
DO HX^VENPCC1F(DFN,DEFEF)
+15 ; LINK TO OCX OBJECTS ON PEDS FORM
NEW SPECHOLD
IF $DATA(^VEN(7.62,"AB",DEFEF))
DO SPEC^VENPCC1C(DFN,DEFEF)
+16 ; SPECIAL DATA MINING CODE FOR THIS TEMPLATE
SET %=$GET(^VEN(7.41,+$GET(DEFEF),4))
IF $LENGTH(%)
XECUTE ("D "_%_"(DFN)")
V22 ; UPDATED VER 2.2 EXTENSIONS
IF $LENGTH($TEXT(VER22^VENPCC1G))
DO VER22^VENPCC1G(DFN,PRV,VISIT,DEFEF,DEPTIEN)
V25 ; VER 2.5 EXTENSIONS
IF $LENGTH($TEXT(VER25^VENPCC1L))
DO VER25^VENPCC1L(DFN,PRV,VISIT,DEFEF,DEPTIEN)
ANMC ; CUSTOM PCC+ CODE FOR ALASKA
IF DUZ(2)=1665
IF $LENGTH($TEXT(^VENPCCAK))
DO ^VENPCCAK(DFN,DEFEF)
FORM ; COMPONENT FRAMEWORK DATA
IF $PIECE($GET(^VEN(7.41,+$GET(DEFEF),21)),U)
IF $LENGTH($TEXT(FORM^VENPCC1S))
DO FORM^VENPCC1S(DFN,VISIT,DEFEF)
MOJO ; SPECIAL EXTENSIONS FOR MOJO (VER 3.0)
IF $DATA(MOJOFLAG)
IF $LENGTH($TEXT(MOJODATA^VENPCCW))
Begin DoDot:1
+1 ; NEW WAY TO GET THE FID FROM THE MOJO FORM FILE
SET @TMP@(1,"u100")=$PIECE($GET(^VEN(7.46,+$GET(DEFEF),0)),U,2)
IF @TMP@(1,"u100")=""
QUIT
+2 ; OUTPUTS DATA DIRECTLY TO MOJO ADO ARRAY
DO MOJODATA^VENPCCW
+3 QUIT
End DoDot:1
QUIT
+4 ; HS ONLY WITH OUTGUIDE
IF $GET(HSONLY)
IF $GET(OGFLAG)
SET OGONLY=1
DO TXT^VENPCC1(DFN)
KILL OGONLY,OGFLAG,@TMP
XECUTE ("I 0")
GOTO HS
DATA ; BUILD THE DATA FILE FOR THE CURRENT TEMPLATE
DO TXT^VENPCC1(DFN)
IF $DATA(STOP)
QUIT
+1 KILL @TMP
+2 IF $GET(EFONLY)!($GET(OGONLY))
HS ; BUILD THE HEALTH SUMMARY DATA FILE
IF '$TEST
DO HS^VENPCC2A(DFN,DEFHS,VISIT,DEPTIEN)
+1 IF $GET(JOB)
KILL ^TMP("VEN MON",JOB)
+2 QUIT
+3 ;
UNPACK(VARS) ; EP-FOR UNPACKING THE LOCAL VARIABLE LIST
+1 IF '$LENGTH($GET(DUZ(0)))
SET %=$CHAR(68,85,90)
SET @%@(0)=$CHAR(64)
+2 NEW I,X,Y,%
+3 FOR I=1:1:$LENGTH(VARS,U)
SET %=$PIECE(VARS,U,I)
IF $LENGTH(%)
SET X=$PIECE(%,"=",1)
SET Y=$PIECE(%,"=",2,99)
XECUTE "S "_X_"="""_Y_""""
+4 QUIT
+5 ;
HEAD ; EP - GET HEADER FILE
+1 ; TRADITIONAL WAY TO BUILD THE HEADER ARRAY
+2 NEW F,I,X,Y,%
+3 SET PATH2=$GET(^VEN(7.5,CFIGIEN,2))
+4 IF PATH2=""
SET STOP=1
DO ERR7^VENPCC1
QUIT
+5 SET %=$$HEADER^VENPCCU(+$GET(DEFEF))
+6 SET F=%_"header.txt"
+7 SET POP=$$OPN^VENPCCP(PATH2,F,"R","R X")
+8 IF POP
SET STOP=1
QUIT
+9 FOR I=1:1:$LENGTH(X,U)
SET Y=$PIECE(X,U,I)
SET @TMP@(9,I)=Y
+10 QUIT
+11 ;
HEAD25 ; EP - MAKE HEADER GLOBAL FOR VERSION 25
+1 NEW HGIEN,HIEN,HDR,MN,CNT
+2 SET HGIEN=$ORDER(^VEN(7.49,"B","25",0))
IF 'HGIEN
QUIT
+3 SET HIEN=0
SET CNT=0
+4 FOR
SET HIEN=$ORDER(^VEN(7.49,HGIEN,1,HIEN))
IF 'HIEN
QUIT
Begin DoDot:1
+5 SET MN=$GET(^VEN(7.49,HGIEN,1,HIEN,0))
IF '$LENGTH(MN)
QUIT
+6 SET CNT=CNT+1
+7 SET @TMP@(9,CNT)=MN
+8 QUIT
End DoDot:1
+9 QUIT
+10 ;
HDR(DEPTIEN) ; EP - HEADER LINES
+1 NEW %,I,X
+2 SET X=$PIECE($GET(^VEN(7.95,DEPTIEN,0)),U)
SET %=$PIECE($GET(^(0)),U,4)
+3 IF %
SET %=$PIECE($GET(^DIC(40.7,%,0)),U,2)
IF $LENGTH(%)
SET X=X_" "_"("_%_")"
+4 SET @TMP@(1,"hdr")=X
+5 QUIT
+6 ;
MRP() ; EP-RETURN THE MEDICAL RECORDS PRINTER GROUP
+1 NEW IEN,NAME
+2 SET IEN=$PIECE($GET(^VEN(7.95,+$GET(DEPTIEN),2)),U,16)
+3 IF 'IEN
SET IEN=$ORDER(^VEN(7.4,"AC",1,0))
IF 'IEN
QUIT ""
+4 SET NAME=$PIECE($GET(^VEN(7.4,IEN,0)),U)
+5 QUIT NAME
+6 ;
SYS(DFN,DEFEF) ; EP-NEW SYSTEM PREFERENCES
+1 IF '$DATA(^DPT(DFN,0))
QUIT
+2 IF '$DATA(^VEN(7.41,+$GET(DEFEF),0))
QUIT
+3 NEW MIEN,TYPE,MMF,PCE,CLASS,SS,HIEN,OSET,NEWSURV,NEWIMM
+4 SET CLASS=$$CLASS^VENPCC1C(DFN)
IF 'CLASS
QUIT
+5 ; USE NEW SURVEILLANCE LIST
SET NEWSURV=0
IF $PIECE($GET(^VEN(7.41,+$GET(DEFEF),5)),U,1)
SET NEWSURV=1
+6 ; USE IMMUNIZATION PKG 7.0
SET NEWIMM=0
XECUTE "I $L($T(IMMHX^BIRPC)),$L($T(BI^APCHS11C)),$$BI^APCHS11C S NEWIMM=1"
CHKLST ; NEW CHECKLIST, VER 2.5
IF $ORDER(^VEN(7.41,+$GET(DEFEF),17,0))
IF $LENGTH($TEXT(POP^VENPCCC))
IF $PIECE($GET(^VEN(7.41,DEFEF,0)),U,17)
DO POP^VENPCCC(DEFEF,DFN)
GOTO TICK
ORD ; CHECK ORDERABLES FILE AND GET ALL ORDERABLES FOR THIS DEMOG GRP
SET OSET=$$OSET^VENPCC1C(+$GET(DEFEF))
SET SS=7.93
+1 ; ONLY MM FIELDS FOR ORDERABLES ARE CHECKED
SET HIEN=0
FOR
SET HIEN=$ORDER(^VEN(7.42,"AS",1,HIEN))
IF 'HIEN
QUIT
Begin DoDot:1
+2 ; GET MAIL MERGE FIELD NAME
SET MMF=$PIECE($GET(^VEN(7.42,HIEN,0)),U)
IF '$LENGTH(MMF)
QUIT
+3 SET MIEN=0
OSET ; IF ORDER SETS ARE DEFINED
IF $GET(OSET)
Begin DoDot:2
+1 ; FIND MM FIELD THAT MATCHES THE PATIENTS CLASS AND ASSIGN VALUE
FOR
SET MIEN=$ORDER(^VEN(7.93,"AS",OSET,MMF,MIEN))
IF 'MIEN
QUIT
IF $$XSET^VENPCC1C(SS,DFN,MIEN,MMF,CLASS,DEFEF)
QUIT
+2 QUIT
NOOSET ; IF ORDER SETS NOT DEFINED
End DoDot:2
QUIT
+1 ; FIND MM FIELD THAT MATCHES THE PATIENTS CLASS AND ASSIGN VALUE
FOR
SET MIEN=$ORDER(^VEN(7.93,"C",MMF,MIEN))
IF 'MIEN
QUIT
IF $$XSET^VENPCC1C(SS,DFN,MIEN,MMF,CLASS,DEFEF)
QUIT
+2 QUIT
End DoDot:1
TICK ; CHECK TICKLER FILE
SET SS=7.94
ROS ; GET ROS DATA
SET MMF="x"
+1 ; L0OP THROUGH ALL THE "x" MAIL MERGE FIELDS IN TICKLER FILE
FOR
SET MMF=$ORDER(^VEN(7.94,"C",MMF))
IF MMF'["x"
QUIT
Begin DoDot:1
+2 SET MIEN=0
+3 ; FIND MM FIELD THAT MATCHES THE PATIENTS CLASS AND ASSIGN VALUE
FOR
SET MIEN=$ORDER(^VEN(7.94,"C",MMF,MIEN))
IF 'MIEN
QUIT
IF $$XSET^VENPCC1C(SS,DFN,MIEN,MMF,CLASS,DEFEF)
QUIT
+4 QUIT
End DoDot:1
SURV ; GET HEALTH MAINT REMINDER DATA
+1 ; OLD SURVEILLANCE METHOD
IF 'NEWSURV
IF 'NEWIMM
DO OLDSURV
QUIT
+2 ; NEW SURVEILLANCE METHODS
IF NEWSURV
IF NEWIMM
DO NEWSURV
DO NEWIMM
QUIT
+3 DO OLDSURV
+4 IF NEWIMM
DO IF^VENPCC1C
QUIT
+5 DO ARR^VENPCC1E(+$GET(DFN))
+6 QUIT
+7 ;
OLDSURV ; GET HEALTH MAINT REMINDER DATA THE OLD WAY
SET MMF="h"
+1 ; L0OP THROUGH ALL THE "h" MAIL MERGE FIELDS IN TICKLER FILE
FOR
SET MMF=$ORDER(^VEN(7.94,"C",MMF))
IF MMF'["h"
QUIT
Begin DoDot:1
+2 SET MIEN=0
+3 ; FIND MM FIELD THAT MATCHES THE PATIENTS CLASS AND ASSIGN VALUE
FOR
SET MIEN=$ORDER(^VEN(7.94,"C",MMF,MIEN))
IF 'MIEN
QUIT
IF $$XSET^VENPCC1C(SS,DFN,MIEN,MMF,CLASS,DEFEF)
QUIT
+4 QUIT
End DoDot:1
+5 QUIT
+6 ;
NEWSURV ; EP - NEW METHOD FOR GETTING HEALTH MAINT REMINDER DATA ; h26-h50
+1 DO ARR^VENPCC1E(+$GET(DFN))
+2 QUIT
+3 ;
NEWIMM ; EP - NEW METHOD FOR GETTING IMM HX ; h9-h25
+1 DO IF^VENPCC1C
+2 QUIT
+3 ;
