VENPCCA ; IHS/OIT/GIS - NEW CHECK IN MODULE ;
;;2.6;PCC+;**1,3,4**;APR 03, 2012;Build 24
;
; ERROR MGMT FOR VER 2.2
; NURSE CHECK IN SUPPORTED IN 2.5
;
N TMSG
PATIENT ; EP-FOR LOOPING TO NEXT PATIENT
S %=+$O(^TMP("VEN TASK",0)),TMSG=$G(^TMP("VEN TASK",%))
I $G(PIMSDFN) D G CLINIC ; PATCHED BY GIS/OIT 6/15/06 ; PCC+ 2.5 PATCH 5
. W !,"A PCC+ form will be generated for ",$P($G(^DPT(PIMSDFN,0)),U)
. W !,"But first, please answer the following questions...",!
. S PATIENT=PIMSDFN
. Q
W !!,"Patient: " I $D(PATIENT) W $P($G(^DPT(PATIENT,0)),U),"// "
R X:$G(DTIME,600) I '$T Q
I $G(PATIENT),X="" S X="`"_PATIENT
I X=""!(X?1."^") Q
I X?1."?" W !,?5,"Enter name (LAST,FIRST - no space after comma), partial name, DOB, or SSN" G PATIENT
S DIC="^DPT(",DIC(0)="EQM" D ^DIC I Y=-1 G PATIENT
S PATIENT=+Y K DIC
S %=$P(Y,U,2) I $E(%,1,5)="DEMO," S VENDEMO=2 ; IF ITS A DEMO PATIENT, DON'T CREATE A VISIT
UP I $P($G(^VEN(7.5,CFIGIEN,0)),U,8)!($G(CHECKIN)) D
. I $G(HSONLY)!($G(EFONLY))!($G(OGONLY)) Q
. S %=$$DATES^VENPCCMF(PATIENT) I $L(%) W !,%
. I '$G(CHECKIN) W !,"Review/update patient registration information" S %=1 D YN^DICN I %'=1 Q
. S UPDEM=DT D PAT^VENPCCD(PATIENT) ; UPDATE DEMOGRAPHICS
. Q
I $G(CHECKIN) Q
CLINIC S %=$P($G(^VEN(7.5,CFIGIEN,0)),U,6) I % S Y=% G CL1 ; THIS SITE ONLY HAS 1 CLINIC - NO NEED TO ASK
I $G(HSONLY) S Y=$O(^VEN(7.95,0)) G CL1 ; Y IS JUST A TEMPORARY PLACEHOLDER AT THIS TIME
S DIC("A")="Clinic: " I $D(DEPTIEN) S DIC("B")=$P($G(^VEN(7.95,DEPTIEN,0)),U)
S DIC("S")="I '$P($G(^(2)),U,7)" ; MUST BE AN ACTIVE DESTINATION
S DIC="^VEN(7.95,",DIC(0)="AEQM" D ^DIC K DIC I Y=-1 Q:$G(CHECKIN)=-1 Q:$G(PIMSDFN) G:X=""!(X?1."^") PATIENT Q
CL1 ;
S DEPTIEN=+Y,CLINIC=$P($G(^VEN(7.95,DEPTIEN,0)),U,4) ; CLINIC STOP
I '$D(^DIC(40.7,+CLINIC,0)) S ERR="No valid clinic entry in the DEPARTMENT file" D ERR^VENPCC1(ERR) W !!,"Internal error! Notify site manager..." Q ; DEPT MUST BE A VALID CLINIC STOP
S LOC=$P($G(^VEN(7.95,DEPTIEN,2)),U,4) I LOC="" S LOC=$G(DUZ(2)) I LOC="" S ERR="Location undefined" D ERR^VENPCC1(ERR) W !!,"Internal error! Notify site manager" Q
I $P($G(^VEN(7.95,+$G(DEPTIEN),2)),U,13),'$D(EFONLY) N EFONLY S EFONLY=1 ; NEVER PRINT HS
SPGRP ; PATCHED BY GIS/OIT 1/15/06 ; PCC+ 2.5 PATCH 2
; CHECK FOR A SPECIAL PRINT GROUP - FOR HS ONLY, TELE TRIAGE & CHART REVIEW
; GET SPGRP = IEN, NULL OR -1 ; SPGRP OVERRIDES THE PGRP IN THE PRINT DEAMON
S %=$$PGRP^VENPCC(CLINIC) I %=-1 W !,"No valid printer location defined! Request cancelled..." Q
I $L(%) S SPGRP=% ; IN MOST CASES, NULL WILL BE RETURNED BECAUSE NO SPECIAL CASE EXISTS
I $G(HSONLY) S PRVIEN=$G(DUZ),APPT="" G EF
I $G(EHRFLAG) S VIEN=$$DUP^VENPCC(PATIENT,DEPTIEN) I 'VIEN Q ; FAILED TO LINK TO A VALID EHR VISIT!!!
S VIEN=$$DUP^VENPCC(PATIENT,DEPTIEN) G PRV
I VIEN N VENDEMO S VENDEMO=2
E I $D(REPRINT) W !!,"This option can only be used to REPRINT forms",!,"You must use the Scheduling Package to print the original!!" H 5 Q
I $P($G(^VEN(7.95,DEPTIEN,2)),U,3) S VPFLAG=1
PRV S DIC("A")="Provider for this visit: "
I $G(PRVIEN) S DIC("B")=$P($G(^VA(200,PRVIEN,0)),U)
E S %=$P($G(^VEN(7.95,DEPTIEN,2)),U,2) I % S DIC("B")=$P($G(^VA(200,%,0)),U)
S DIC=200
S DIC(0)="AEQM" D ^DIC K DIC
I X="" S Y=$$GP^VENPCCU W " ("_$P($G(^VA(200,+Y,0)),U)_")"
I Y=-1 G:X?1."^" PATIENT Q
S PRVIEN=+Y,APPT=""
I $P($G(^VEN(7.95,DEPTIEN,2)),U,15) N BLOCK S BLOCK=1 G NOW
APPT I $G(VPFLAG) D Q:$D(DTOUT) I $G(%Y)?1."^" G PATIENT
. W !,"Does this patient have an appointment"
. S %=2 D YN^DICN
. S APPT=$S(%=1:1,%=2:0,1:"")
. Q
EF ; EP-DEFAULT EF
I '$G(HSONLY),'$G(OGONLY),'$G(VPFLAG)
E S DEFEF="" G HS
I $G(DEFEF) S DIC("B")=$P($G(^VEN(7.41,DEFEF,0)),U)
E S %=+$P($G(^VEN(7.95,DEPTIEN,2)),U,5) S DIC("B")=$P($G(^VEN(7.41,%,0)),U)
S DIC("A")="Encounter form: "
S DIC(0)="AEQM",DIC="^VEN(7.41,"
D ^DIC K DIC
I Y=-1 G:X=""!(X?1."^") PATIENT Q
BEF I $P($G(^VEN(7.41,+Y,0)),U,13) W !,"This form is temporarily out of service. Use another form..." G EF ; EF HAS BEEN BLOCKED, TRY AGAIN
S DEFEF=+Y
I $G(EHRFLAG),$P($G(^VEN(7.41,DEFEF,14)),U,7) W !,"Warning, this form is not configured to display EHR vital signs!"
I $P($G(^VEN(7.41,+Y,0)),U,16) W !," Administrative form..." S EFONLY=1,NOVISIT=1,DEFHS="" G NOW ; ADMIN FORM, NO COMPANION DOCS, NO VISIT CREATED
HS ; EP - GET DEFAULT HS
I $G(EFONLY)!($G(OGONLY)) S DEFHS="" G PULL
S %=+$P($G(^VEN(7.95,DEPTIEN,2)),U,6) S DIC("B")=$P($G(^APCHSCTL(%,0)),U)
I DIC("B")="ADULT REGULAR" S %=+$P($G(^DPT(PATIENT,0)),U,3) I % S %=(DT-%)\10000 I %<12 S DIC("B")="PEDIATRIC"
S DIC("A")="Health summary type: "
S DIC(0)="AEQM",DIC="^APCHSCTL("
D ^DIC K DIC I Y=-1 G:X=""!(X?1."^") PATIENT Q
S DEFHS=+Y
PULL ; EP - PULL CHART?
I $D(DEMODATA) G NOW
K OGFLAG
I $P($G(^VEN(7.95,+$G(DEPTIEN),2)),U,10)!('$D(^VEN(7.4,"AC"))) G NOW ; DO NOT PULL OG FOR THIS CLINIC
I $G(OGONLY) S OGFLAG=1 G NOW
I $P($G(^VEN(7.5,CFIGIEN,0)),U,9) D I $G(%Y)="^" K %Y G PATIENT
. W !,"Print outguide/Pull chart"
. S %=1 D YN^DICN
. I %=1 S OGFLAG=1
. Q
NOW I $G(SBFLAG) G FILE ; EP - FOR FSI FRONT END
D NOW^%DTC S NOW=$E(%,1,12)
I $G(EHRFLAG) G VCN ; AT THIS POINT, IF THE EHR FLAG EXISTS, THEN THE VIEN MUST EXIST
I $G(NCIFLAG) G:$G(VIEN) VCN I $G(NOVISIT) W !,"A valid visit must exist to use the NCI option.",!,"PCC+ can't find a valid visit, so the NCI dialog will be skipped!" K NCIFLAG
I $G(NOVISIT) D G FILE ; CREATE PLACEHOLDER VISIT INFO AND VCN
. S VIEN=9_$P($H,",",2)_U_PATIENT_U_NOW
. S VCN=$$CHART^VENPCCU(PATIENT,DUZ(2))_".1X"
. W !,"No visit created!"
. Q
VISIT I $G(HSONLY)!($G(VENDEMO)) D G:VIEN FILE Q ; EP - NO VISIT CREATED
. S VIEN=$G(VIEN)
. I 'VIEN S VIEN=$O(^AUPNVSIT("AC",PATIENT,999999999),-1) ; IF NO DUP, USE THE LAST VISIT
. I 'VIEN,$G(VENDEMO)=1 W !,"Unable to create a demo form for this patient (missing visit)"
. I 'VIEN W !,"This patient has no visits! Request cancelled...",!! Q
. S VCN=$P($G(^AUPNVSIT(VIEN,11)),U,3)
. I 'VCN S VCN=$G(^AUPNVSIT(VIEN,"VCN"))
. I 'VCN S VCN=$P($$VCN^VENPCC3(VIEN,DEPTIEN),U)
. I 'VCN,$G(VENDEMO)=1 W !,"Unable to create a demo form for this patient (missing VCN)"
. I 'VCN W !,"This patient has no VCN! Request cancelled...",!! S VIEN=""
. Q
; I $P($G(^VEN(7.5,CFIGIEN,0)),U,18) W !,"Are you sure you want to create a visit for this patient" S %=1 D YN^DICN I %'=1 K PATIENT W !,"NO VISIT CREATED! Try again..." G PATIENT ; CONFIRM VISIT
S VIEN=$$VISIT^VENPCC3(PATIENT,NOW,LOC,CLINIC)
I 'VIEN S ERR=$S($L(VIEN):VIEN,1:"Failed to create a visit") D ERR^VENPCC1(ERR) W !,"Internal error! Notify site manager" Q
VCN S VCN=$P($G(^AUPNVSIT(+$G(VIEN),11)),U,3)
I VCN="" S VCN=$G(^AUPNVSIT(+$G(VIEN),"VCN"))
I VCN="" S VCN=$P($$VCN^VENPCC3(VIEN,DEPTIEN),U)
I VCN'?1.N1"."1.N1.A S ERR="Patient does not appear to be registered properly at this clinic!" W !,ERR,!,"Request terminated..." Q ; VCN ERROR ; PATCHED BY GIS/OIT 2/1/06 ; PCC + VERSION 2.5, PATCH 3
FILE I '$D(HSONLY),'$D(OGONLY) D ; SPECIAL DIALOG/PROCESSING IF AN ENCOUNTER FORM WILL BE PRINTED
. S %=$G(^VEN(7.41,DEFEF,22)) I %'="" X ("D "_"("_PATIENT_")") ; SPECIAL CHECK IN DIALOG FOR THIS FORM
. I $D(^AUPNCPG("B",PATIENT)),$L($T(OB^VENPCC3)) D OB^VENPCC3(PATIENT) ; CHECK EVERY ELIGIBLE VISIT FOR AN OPEN PREGNANCY LOOP
. I $G(NCIFLAG),$L($T(MSR^VENPCCAM)) D MSR^VENPCCAM(VIEN,DEPTIEN) I $G(NCCANCEL) Q ; ASK MEASUREMENTS DURING CHECKIN FOR 2.5
. I $D(VENDEMO),'$G(NCIFLAG) Q
. D QUEUE(VIEN,DEPTIEN,$G(OGFLAG),$P($G(^VEN(7.95,DEPTIEN,2)),U,3),$G(UPDEM),PRVIEN) ; ADD PRV PARAM FOR 2.5
. Q
I $G(NCCANCEL) Q ; ABORT NURSE CHECK IN
S PRV=PRVIEN,VISIT=VIEN
KILL K %,%H,%I,AUPNDAYS,AUPNDOB,AUPNDOD,AUPNPAT,AUPNSEX,SEX,CLINIC,DISYS,NOW,PATIENT,PRVIEN,TYPE,VIEN,X,Y,LOC
I $G(NCCANCEL) Q
RUN I $G(VENDEMO) W ! W:VENDEMO=2 "Duplicate encounter! " W "No visit created"
I $G(BLOCK) W !!,"PCC+ has been temporarily shut down at this clinic.",!,"You may continue to register patients, but no forms will be printed..." W !!! G PATIENT
I $D(VPFLAG) S HSONLY=1 W !,"This information will be sent to the clinic..."
E W !,"Submitting request for ",$S($G(OGONLY):"OutGuide",$G(EFONLY):"Encounter Form",$G(HSONLY):"Health Summary",1:"Encounter form and Health Summary..."),!
TMAN I $D(NOTASK) D EN1("D") G CLEANUP
S VARS=$$PACK^VENPCC,EXT=$G(EXT)
D EN1("J")
MON I $P($G(^VEN(7.5,+$G(CFIGIEN),0)),U,11) H 1 I $D(^TMP("VEN MON",$J)) F W *13,?79,*13,^TMP("VEN MON",$J) R %:1 I $T!('$D(^TMP("VEN MON",$J))) Q
I $D(VPFLAG) K HSONLY,VPFLAG
I $G(CHECKIN) S CHECKIN=+$G(VISIT)
CLEANUP K VISIT,VCN,DEPTIEN,PRV,DEFEF,DEFHS,%DT,ELIG,FILE,I,PATH,TOT,SPGRP,VARS,EXT,APPT,OGFLAG
I $G(NCIFLAG) K NCIFLAG Q
I $G(SBFLAG)!($G(CHECKIN))!($G(REPRINT))!($G(PIMSDFN)) Q
I $G(VENDEMO)=2 K VENDEMO
I '$P($G(^VEN(7.5,+$G(CFIGIEN),0)),U,12) D
. S %=+$O(^TMP("VEN TASK",0))
. S X=$G(^TMP("VEN TASK",%))
. I $L(X),X=TMSG X ("J"_" STUCK"_U_"VENPCCA") ; PRINT DEAMON MAY BE STUCK. AUTOMATICALLY RESET/RESTART IT.
. Q
I $G(NOTASK) Q
W !!! G PATIENT
;
EN1(MODE,SILENT) ; EP-UNIVERSAL ENTRY POINT FOR INITIATING PCC+
I '$D(DEFHS) S DEFHS="" ; PATCHED BY GIS/OIT 7/7/05
I $G(VISIT),$L($G(VCN)),$D(DEFEF),$G(DEPTIEN)
E S ERR="Can't initiate data extraction process. Req'd vars missing" D ERR^VENPCC1(ERR) Q
I '$D(^VA(200,+$G(PRV),0)) D
. S PRV=+$P($G(^VEN(7.95,+$G(DEPTIEN),2)),U,2)
. I '$D(^VA(200,PRV,0)) S PRV=+$P($G(^VEN(7.5,$$CFG^VENPCCU,0)),U,13)
. Q
I '$D(^VA(200,PRV,0)) S ERR="Can't initiate data extraction process. No provider specified" D ERR^VENPCC1(ERR) Q
I $G(MODE)="" S MODE="D"
I '$G(SILENT),$$UMSG^VENPCCP2(DEPTIEN,DEFEF,DEFHS,$G(VARS)) ; DISPLAY CURRENT ERROR STATUS
X (MODE_" PRINT^VENPCC10(VISIT,VCN,DEPTIEN,PRV,DEFEF,DEFHS,$G(APPT),$G(VARS),$G(EXT))")
Q
;
STUCK ; EP-RESET/RESTART SYSTEM IF IT IS STUCK. NO LOSS OF FILES.
N M1,M2,J
S J=$O(^TMP("VEN TASK",0)) I 'J Q
S M1=$G(^TMP("VEN TASK",J)) I '$L(M1) Q
H 60
S M2=$G(^TMP("VEN TASK",J)) I '$L(M2) Q
I M1=M2 D KILLTASK^VENPCCP ; KILL OFF TASK IF GBL VAL IS UNCHANGED FOR 60 SECONDS
Q
;
NOVISIT ; EP-ENTRY POINT FOR GENERATING PCC+ FORMS WITHOUT CREATING A VISIT
N NOVISIT S NOVISIT=1
G ^VENPCC
;
QUEUE(VISIT,DEPTIEN,OGFLAG,TRFLAG,UPDEM,PRVIEN) ; EP-UPDATE CHECKIN AND QUEUE FILES ; 2.5. ADD PARAMETER FOR PROVIDER
QSIG ; EP - SIGNATURE EP FOR ANMC
I '$D(^AUPNVSIT(+$G(VISIT),0)),'$G(NOVISIT) Q
I $D(VENDEMO) Q
I '$D(^VEN(7.95,+$G(DEPTIEN),0)) Q
N QTYPE,MIEN,QUE,DIG,DIH,DIU,DIV,DIW,DA,DR,DIE,DIC,X,Y,D0,D,DQ,DI,TIME,DLAYGO,DFN,%,VCN,INIT
I $G(NOVISIT) Q:'$G(PATIENT) S DFN=PATIENT,TIME=$$NOW^VENPCCU,VISIT="" G MRQ
I VISIT[U S DFN=$P(VISIT,U,2),TIME=$P(VISIT,U,3),VISIT="" G MRQ
S X=^AUPNVSIT(VISIT,0)
S TIME=$$NOW^VENPCCU
S DFN=$P(X,U,5),PRVIEN=$G(PRVIEN)
MRQ S MIEN=$O(^VEN(7.95,"B","MEDICAL RECORDS",0)) I 'MIEN Q
I $G(OGFLAG) S QTYPE="MEDICAL RECORDS" D Q1 K QTYPE
S %=$P($G(^VEN(7.95,+$G(DEPTIEN),1)),U,1+$G(TRFLAG))
I % S QTYPE=$P($G(^VEN(7.22,%,0)),U)
I $L($G(QTYPE)) D Q1
Q
;
Q1 ; EP-MAKE QUEUE FILE ENTRY
S DIC="^VEN(7.2,",DIC(0)="L",X=""""_TIME_"""",DLAYGO=19707.2
D ^DIC I Y=-1 Q
S DIE=DIC,DA=+Y,QUE=DA
S DR=".03///"_QTYPE_";.04////"_$S(QTYPE="MEDICAL RECORDS":MIEN,1:+$G(DEPTIEN))_";.06////"_DUZ
S DR=DR_";1.1////"_DFN_";1.2////"_VISIT_";.12////"_$P($G(^VEN(7.95,+$G(DEPTIEN),0)),U,5)_";1.4////"_$G(UPDEM)
S DR=DR_";1.5////"_PRVIEN_";1.6////"_$P($G(^AUPNVSIT(+$G(VISIT),11)),U,3) ; ADD PROVIDER INFO FOR VER 2.5
MOJO S %=$G(MOJOFLAG(1)) I $L(%) S DR=DR_".13///"_$E(%) ; CLASSIC, DIGIPEN, OR TABLET
L +^VEN(7.2,DA):5 E Q
D ^DIE L -^VEN(7.2,DA)
Q
;
EXTCKIN(PATIENT) ; EP-CHECK IN ENTRY POINT FOR EXRTERNAL PACKAGES WHERE PATIENT IS KNOWN.
; IF PCC+ CHECKIN IS SUCCESSFUL, VISIT IEN IS RETURNED
N CFIGIEN,CHECKIN
S CFIGIEN=$$CFG^VENPCCU
S CHECKIN=-1
D CLINIC
I CHECKIN=-1 Q ""
Q CHECKIN
;
INIT(PRV) ; EP-RETURN THE PROVIDER'S INITIALS
N X,INIT
S X=$G(^VA(200,+$G(PRV),0)) I '$L(X) Q ""
S INIT=$P(X,U,2) ; CHOOSE BETWEEN INITIALS AND THE FULL NAME
I '$L(INIT),$L($P(X,U)) S INIT=$E($P(X,",",2))_$E(X) ; CREATE INITIALS ON THE FLY
Q $E(INIT,1,3)
;
VENPCCA ; IHS/OIT/GIS - NEW CHECK IN MODULE ;
+1 ;;2.6;PCC+;**1,3,4**;APR 03, 2012;Build 24
+2 ;
+3 ; ERROR MGMT FOR VER 2.2
+4 ; NURSE CHECK IN SUPPORTED IN 2.5
+5 ;
+6 NEW TMSG
PATIENT ; EP-FOR LOOPING TO NEXT PATIENT
+1 SET %=+$ORDER(^TMP("VEN TASK",0))
SET TMSG=$GET(^TMP("VEN TASK",%))
+2 ; PATCHED BY GIS/OIT 6/15/06 ; PCC+ 2.5 PATCH 5
IF $GET(PIMSDFN)
Begin DoDot:1
+3 WRITE !,"A PCC+ form will be generated for ",$PIECE($GET(^DPT(PIMSDFN,0)),U)
+4 WRITE !,"But first, please answer the following questions...",!
+5 SET PATIENT=PIMSDFN
+6 QUIT
End DoDot:1
GOTO CLINIC
+7 WRITE !!,"Patient: "
IF $DATA(PATIENT)
WRITE $PIECE($GET(^DPT(PATIENT,0)),U),"// "
+8 READ X:$GET(DTIME,600)
IF '$TEST
QUIT
+9 IF $GET(PATIENT)
IF X=""
SET X="`"_PATIENT
+10 IF X=""!(X?1."^")
QUIT
+11 IF X?1."?"
WRITE !,?5,"Enter name (LAST,FIRST - no space after comma), partial name, DOB, or SSN"
GOTO PATIENT
+12 SET DIC="^DPT("
SET DIC(0)="EQM"
DO ^DIC
IF Y=-1
GOTO PATIENT
+13 SET PATIENT=+Y
KILL DIC
+14 ; IF ITS A DEMO PATIENT, DON'T CREATE A VISIT
SET %=$PIECE(Y,U,2)
IF $EXTRACT(%,1,5)="DEMO,"
SET VENDEMO=2
UP IF $PIECE($GET(^VEN(7.5,CFIGIEN,0)),U,8)!($GET(CHECKIN))
Begin DoDot:1
+1 IF $GET(HSONLY)!($GET(EFONLY))!($GET(OGONLY))
QUIT
+2 SET %=$$DATES^VENPCCMF(PATIENT)
IF $LENGTH(%)
WRITE !,%
+3 IF '$GET(CHECKIN)
WRITE !,"Review/update patient registration information"
SET %=1
DO YN^DICN
IF %'=1
QUIT
+4 ; UPDATE DEMOGRAPHICS
SET UPDEM=DT
DO PAT^VENPCCD(PATIENT)
+5 QUIT
End DoDot:1
+6 IF $GET(CHECKIN)
QUIT
CLINIC ; THIS SITE ONLY HAS 1 CLINIC - NO NEED TO ASK
SET %=$PIECE($GET(^VEN(7.5,CFIGIEN,0)),U,6)
IF %
SET Y=%
GOTO CL1
+1 ; Y IS JUST A TEMPORARY PLACEHOLDER AT THIS TIME
IF $GET(HSONLY)
SET Y=$ORDER(^VEN(7.95,0))
GOTO CL1
+2 SET DIC("A")="Clinic: "
IF $DATA(DEPTIEN)
SET DIC("B")=$PIECE($GET(^VEN(7.95,DEPTIEN,0)),U)
+3 ; MUST BE AN ACTIVE DESTINATION
SET DIC("S")="I '$P($G(^(2)),U,7)"
+4 SET DIC="^VEN(7.95,"
SET DIC(0)="AEQM"
DO ^DIC
KILL DIC
IF Y=-1
IF $GET(CHECKIN)=-1
QUIT
IF $GET(PIMSDFN)
QUIT
IF X=""!(X?1."^")
GOTO PATIENT
QUIT
CL1 ;
+1 ; CLINIC STOP
SET DEPTIEN=+Y
SET CLINIC=$PIECE($GET(^VEN(7.95,DEPTIEN,0)),U,4)
+2 ; DEPT MUST BE A VALID CLINIC STOP
IF '$DATA(^DIC(40.7,+CLINIC,0))
SET ERR="No valid clinic entry in the DEPARTMENT file"
DO ERR^VENPCC1(ERR)
WRITE !!,"Internal error! Notify site manager..."
QUIT
+3 SET LOC=$PIECE($GET(^VEN(7.95,DEPTIEN,2)),U,4)
IF LOC=""
SET LOC=$GET(DUZ(2))
IF LOC=""
SET ERR="Location undefined"
DO ERR^VENPCC1(ERR)
WRITE !!,"Internal error! Notify site manager"
QUIT
+4 ; NEVER PRINT HS
IF $PIECE($GET(^VEN(7.95,+$GET(DEPTIEN),2)),U,13)
IF '$DATA(EFONLY)
NEW EFONLY
SET EFONLY=1
SPGRP ; PATCHED BY GIS/OIT 1/15/06 ; PCC+ 2.5 PATCH 2
+1 ; CHECK FOR A SPECIAL PRINT GROUP - FOR HS ONLY, TELE TRIAGE & CHART REVIEW
+2 ; GET SPGRP = IEN, NULL OR -1 ; SPGRP OVERRIDES THE PGRP IN THE PRINT DEAMON
+3 SET %=$$PGRP^VENPCC(CLINIC)
IF %=-1
WRITE !,"No valid printer location defined! Request cancelled..."
QUIT
+4 ; IN MOST CASES, NULL WILL BE RETURNED BECAUSE NO SPECIAL CASE EXISTS
IF $LENGTH(%)
SET SPGRP=%
+5 IF $GET(HSONLY)
SET PRVIEN=$GET(DUZ)
SET APPT=""
GOTO EF
+6 ; FAILED TO LINK TO A VALID EHR VISIT!!!
IF $GET(EHRFLAG)
SET VIEN=$$DUP^VENPCC(PATIENT,DEPTIEN)
IF 'VIEN
QUIT
+7 SET VIEN=$$DUP^VENPCC(PATIENT,DEPTIEN)
GOTO PRV
+8 IF VIEN
NEW VENDEMO
SET VENDEMO=2
+9 IF '$TEST
IF $DATA(REPRINT)
WRITE !!,"This option can only be used to REPRINT forms",!,"You must use the Scheduling Package to print the original!!"
HANG 5
QUIT
+10 IF $PIECE($GET(^VEN(7.95,DEPTIEN,2)),U,3)
SET VPFLAG=1
PRV SET DIC("A")="Provider for this visit: "
+1 IF $GET(PRVIEN)
SET DIC("B")=$PIECE($GET(^VA(200,PRVIEN,0)),U)
+2 IF '$TEST
SET %=$PIECE($GET(^VEN(7.95,DEPTIEN,2)),U,2)
IF %
SET DIC("B")=$PIECE($GET(^VA(200,%,0)),U)
+3 SET DIC=200
+4 SET DIC(0)="AEQM"
DO ^DIC
KILL DIC
+5 IF X=""
SET Y=$$GP^VENPCCU
WRITE " ("_$PIECE($GET(^VA(200,+Y,0)),U)_")"
+6 IF Y=-1
IF X?1."^"
GOTO PATIENT
QUIT
+7 SET PRVIEN=+Y
SET APPT=""
+8 IF $PIECE($GET(^VEN(7.95,DEPTIEN,2)),U,15)
NEW BLOCK
SET BLOCK=1
GOTO NOW
APPT IF $GET(VPFLAG)
Begin DoDot:1
+1 WRITE !,"Does this patient have an appointment"
+2 SET %=2
DO YN^DICN
+3 SET APPT=$SELECT(%=1:1,%=2:0,1:"")
+4 QUIT
End DoDot:1
IF $DATA(DTOUT)
QUIT
IF $GET(%Y)?1."^"
GOTO PATIENT
EF ; EP-DEFAULT EF
+1 IF '$GET(HSONLY)
IF '$GET(OGONLY)
IF '$GET(VPFLAG)
+2 IF '$TEST
SET DEFEF=""
GOTO HS
+3 IF $GET(DEFEF)
SET DIC("B")=$PIECE($GET(^VEN(7.41,DEFEF,0)),U)
+4 IF '$TEST
SET %=+$PIECE($GET(^VEN(7.95,DEPTIEN,2)),U,5)
SET DIC("B")=$PIECE($GET(^VEN(7.41,%,0)),U)
+5 SET DIC("A")="Encounter form: "
+6 SET DIC(0)="AEQM"
SET DIC="^VEN(7.41,"
+7 DO ^DIC
KILL DIC
+8 IF Y=-1
IF X=""!(X?1."^")
GOTO PATIENT
QUIT
BEF ; EF HAS BEEN BLOCKED, TRY AGAIN
IF $PIECE($GET(^VEN(7.41,+Y,0)),U,13)
WRITE !,"This form is temporarily out of service. Use another form..."
GOTO EF
+1 SET DEFEF=+Y
+2 IF $GET(EHRFLAG)
IF $PIECE($GET(^VEN(7.41,DEFEF,14)),U,7)
WRITE !,"Warning, this form is not configured to display EHR vital signs!"
+3 ; ADMIN FORM, NO COMPANION DOCS, NO VISIT CREATED
IF $PIECE($GET(^VEN(7.41,+Y,0)),U,16)
WRITE !," Administrative form..."
SET EFONLY=1
SET NOVISIT=1
SET DEFHS=""
GOTO NOW
HS ; EP - GET DEFAULT HS
+1 IF $GET(EFONLY)!($GET(OGONLY))
SET DEFHS=""
GOTO PULL
+2 SET %=+$PIECE($GET(^VEN(7.95,DEPTIEN,2)),U,6)
SET DIC("B")=$PIECE($GET(^APCHSCTL(%,0)),U)
+3 IF DIC("B")="ADULT REGULAR"
SET %=+$PIECE($GET(^DPT(PATIENT,0)),U,3)
IF %
SET %=(DT-%)\10000
IF %<12
SET DIC("B")="PEDIATRIC"
+4 SET DIC("A")="Health summary type: "
+5 SET DIC(0)="AEQM"
SET DIC="^APCHSCTL("
+6 DO ^DIC
KILL DIC
IF Y=-1
IF X=""!(X?1."^")
GOTO PATIENT
QUIT
+7 SET DEFHS=+Y
PULL ; EP - PULL CHART?
+1 IF $DATA(DEMODATA)
GOTO NOW
+2 KILL OGFLAG
+3 ; DO NOT PULL OG FOR THIS CLINIC
IF $PIECE($GET(^VEN(7.95,+$GET(DEPTIEN),2)),U,10)!('$DATA(^VEN(7.4,"AC")))
GOTO NOW
+4 IF $GET(OGONLY)
SET OGFLAG=1
GOTO NOW
+5 IF $PIECE($GET(^VEN(7.5,CFIGIEN,0)),U,9)
Begin DoDot:1
+6 WRITE !,"Print outguide/Pull chart"
+7 SET %=1
DO YN^DICN
+8 IF %=1
SET OGFLAG=1
+9 QUIT
End DoDot:1
IF $GET(%Y)="^"
KILL %Y
GOTO PATIENT
NOW ; EP - FOR FSI FRONT END
IF $GET(SBFLAG)
GOTO FILE
+1 DO NOW^%DTC
SET NOW=$EXTRACT(%,1,12)
+2 ; AT THIS POINT, IF THE EHR FLAG EXISTS, THEN THE VIEN MUST EXIST
IF $GET(EHRFLAG)
GOTO VCN
+3 IF $GET(NCIFLAG)
IF $GET(VIEN)
GOTO VCN
IF $GET(NOVISIT)
WRITE !,"A valid visit must exist to use the NCI option.",!,"PCC+ can't find a valid visit, so the NCI dialog will be skipped!"
KILL NCIFLAG
+4 ; CREATE PLACEHOLDER VISIT INFO AND VCN
IF $GET(NOVISIT)
Begin DoDot:1
+5 SET VIEN=9_$PIECE($HOROLOG,",",2)_U_PATIENT_U_NOW
+6 SET VCN=$$CHART^VENPCCU(PATIENT,DUZ(2))_".1X"
+7 WRITE !,"No visit created!"
+8 QUIT
End DoDot:1
GOTO FILE
VISIT ; EP - NO VISIT CREATED
IF $GET(HSONLY)!($GET(VENDEMO))
Begin DoDot:1
+1 SET VIEN=$GET(VIEN)
+2 ; IF NO DUP, USE THE LAST VISIT
IF 'VIEN
SET VIEN=$ORDER(^AUPNVSIT("AC",PATIENT,999999999),-1)
+3 IF 'VIEN
IF $GET(VENDEMO)=1
WRITE !,"Unable to create a demo form for this patient (missing visit)"
+4 IF 'VIEN
WRITE !,"This patient has no visits! Request cancelled...",!!
QUIT
+5 SET VCN=$PIECE($GET(^AUPNVSIT(VIEN,11)),U,3)
+6 IF 'VCN
SET VCN=$GET(^AUPNVSIT(VIEN,"VCN"))
+7 IF 'VCN
SET VCN=$PIECE($$VCN^VENPCC3(VIEN,DEPTIEN),U)
+8 IF 'VCN
IF $GET(VENDEMO)=1
WRITE !,"Unable to create a demo form for this patient (missing VCN)"
+9 IF 'VCN
WRITE !,"This patient has no VCN! Request cancelled...",!!
SET VIEN=""
+10 QUIT
End DoDot:1
IF VIEN
GOTO FILE
QUIT
+11 ; I $P($G(^VEN(7.5,CFIGIEN,0)),U,18) W !,"Are you sure you want to create a visit for this patient" S %=1 D YN^DICN I %'=1 K PATIENT W !,"NO VISIT CREATED! Try again..." G PATIENT ; CONFIRM VISIT
+12 SET VIEN=$$VISIT^VENPCC3(PATIENT,NOW,LOC,CLINIC)
+13 IF 'VIEN
SET ERR=$SELECT($LENGTH(VIEN):VIEN,1:"Failed to create a visit")
DO ERR^VENPCC1(ERR)
WRITE !,"Internal error! Notify site manager"
QUIT
VCN SET VCN=$PIECE($GET(^AUPNVSIT(+$GET(VIEN),11)),U,3)
+1 IF VCN=""
SET VCN=$GET(^AUPNVSIT(+$GET(VIEN),"VCN"))
+2 IF VCN=""
SET VCN=$PIECE($$VCN^VENPCC3(VIEN,DEPTIEN),U)
+3 ; VCN ERROR ; PATCHED BY GIS/OIT 2/1/06 ; PCC + VERSION 2.5, PATCH 3
IF VCN'?1.N1"."1.N1.A
SET ERR="Patient does not appear to be registered properly at this clinic!"
WRITE !,ERR,!,"Request terminated..."
QUIT
FILE ; SPECIAL DIALOG/PROCESSING IF AN ENCOUNTER FORM WILL BE PRINTED
IF '$DATA(HSONLY)
IF '$DATA(OGONLY)
Begin DoDot:1
+1 ; SPECIAL CHECK IN DIALOG FOR THIS FORM
SET %=$GET(^VEN(7.41,DEFEF,22))
IF %'=""
XECUTE ("D "_"("_PATIENT_")")
+2 ; CHECK EVERY ELIGIBLE VISIT FOR AN OPEN PREGNANCY LOOP
IF $DATA(^AUPNCPG("B",PATIENT))
IF $LENGTH($TEXT(OB^VENPCC3))
DO OB^VENPCC3(PATIENT)
+3 ; ASK MEASUREMENTS DURING CHECKIN FOR 2.5
IF $GET(NCIFLAG)
IF $LENGTH($TEXT(MSR^VENPCCAM))
DO MSR^VENPCCAM(VIEN,DEPTIEN)
IF $GET(NCCANCEL)
QUIT
+4 IF $DATA(VENDEMO)
IF '$GET(NCIFLAG)
QUIT
+5 ; ADD PRV PARAM FOR 2.5
DO QUEUE(VIEN,DEPTIEN,$GET(OGFLAG),$PIECE($GET(^VEN(7.95,DEPTIEN,2)),U,3),$GET(UPDEM),PRVIEN)
+6 QUIT
End DoDot:1
+7 ; ABORT NURSE CHECK IN
IF $GET(NCCANCEL)
QUIT
+8 SET PRV=PRVIEN
SET VISIT=VIEN
KILL KILL %,%H,%I,AUPNDAYS,AUPNDOB,AUPNDOD,AUPNPAT,AUPNSEX,SEX,CLINIC,DISYS,NOW,PATIENT,PRVIEN,TYPE,VIEN,X,Y,LOC
+1 IF $GET(NCCANCEL)
QUIT
RUN IF $GET(VENDEMO)
WRITE !
IF VENDEMO=2
WRITE "Duplicate encounter! "
WRITE "No visit created"
+1 IF $GET(BLOCK)
WRITE !!,"PCC+ has been temporarily shut down at this clinic.",!,"You may continue to register patients, but no forms will be printed..."
WRITE !!!
GOTO PATIENT
+2 IF $DATA(VPFLAG)
SET HSONLY=1
WRITE !,"This information will be sent to the clinic..."
+3 IF '$TEST
WRITE !,"Submitting request for ",$SELECT($GET(OGONLY):"OutGuide",$GET(EFONLY):"Encounter Form",$GET(HSONLY):"Health Summary",1:"Encounter form and Health Summary..."),!
TMAN IF $DATA(NOTASK)
DO EN1("D")
GOTO CLEANUP
+1 SET VARS=$$PACK^VENPCC
SET EXT=$GET(EXT)
+2 DO EN1("J")
MON IF $PIECE($GET(^VEN(7.5,+$GET(CFIGIEN),0)),U,11)
HANG 1
IF $DATA(^TMP("VEN MON",$JOB))
FOR
WRITE *13,?79,*13,^TMP("VEN MON",$JOB)
READ %:1
IF $TEST!('$DATA(^TMP("VEN MON",$JOB)))
QUIT
+1 IF $DATA(VPFLAG)
KILL HSONLY,VPFLAG
+2 IF $GET(CHECKIN)
SET CHECKIN=+$GET(VISIT)
CLEANUP KILL VISIT,VCN,DEPTIEN,PRV,DEFEF,DEFHS,%DT,ELIG,FILE,I,PATH,TOT,SPGRP,VARS,EXT,APPT,OGFLAG
+1 IF $GET(NCIFLAG)
KILL NCIFLAG
QUIT
+2 IF $GET(SBFLAG)!($GET(CHECKIN))!($GET(REPRINT))!($GET(PIMSDFN))
QUIT
+3 IF $GET(VENDEMO)=2
KILL VENDEMO
+4 IF '$PIECE($GET(^VEN(7.5,+$GET(CFIGIEN),0)),U,12)
Begin DoDot:1
+5 SET %=+$ORDER(^TMP("VEN TASK",0))
+6 SET X=$GET(^TMP("VEN TASK",%))
+7 ; PRINT DEAMON MAY BE STUCK. AUTOMATICALLY RESET/RESTART IT.
IF $LENGTH(X)
IF X=TMSG
XECUTE ("J"_" STUCK"_U_"VENPCCA")
+8 QUIT
End DoDot:1
+9 IF $GET(NOTASK)
QUIT
+10 WRITE !!!
GOTO PATIENT
+11 ;
EN1(MODE,SILENT) ; EP-UNIVERSAL ENTRY POINT FOR INITIATING PCC+
+1 ; PATCHED BY GIS/OIT 7/7/05
IF '$DATA(DEFHS)
SET DEFHS=""
+2 IF $GET(VISIT)
IF $LENGTH($GET(VCN))
IF $DATA(DEFEF)
IF $GET(DEPTIEN)
+3 IF '$TEST
SET ERR="Can't initiate data extraction process. Req'd vars missing"
DO ERR^VENPCC1(ERR)
QUIT
+4 IF '$DATA(^VA(200,+$GET(PRV),0))
Begin DoDot:1
+5 SET PRV=+$PIECE($GET(^VEN(7.95,+$GET(DEPTIEN),2)),U,2)
+6 IF '$DATA(^VA(200,PRV,0))
SET PRV=+$PIECE($GET(^VEN(7.5,$$CFG^VENPCCU,0)),U,13)
+7 QUIT
End DoDot:1
+8 IF '$DATA(^VA(200,PRV,0))
SET ERR="Can't initiate data extraction process. No provider specified"
DO ERR^VENPCC1(ERR)
QUIT
+9 IF $GET(MODE)=""
SET MODE="D"
+10 ; DISPLAY CURRENT ERROR STATUS
IF '$GET(SILENT)
IF $$UMSG^VENPCCP2(DEPTIEN,DEFEF,DEFHS,$GET(VARS))
+11 XECUTE (MODE_" PRINT^VENPCC10(VISIT,VCN,DEPTIEN,PRV,DEFEF,DEFHS,$G(APPT),$G(VARS),$G(EXT))")
+12 QUIT
+13 ;
STUCK ; EP-RESET/RESTART SYSTEM IF IT IS STUCK. NO LOSS OF FILES.
+1 NEW M1,M2,J
+2 SET J=$ORDER(^TMP("VEN TASK",0))
IF 'J
QUIT
+3 SET M1=$GET(^TMP("VEN TASK",J))
IF '$LENGTH(M1)
QUIT
+4 HANG 60
+5 SET M2=$GET(^TMP("VEN TASK",J))
IF '$LENGTH(M2)
QUIT
+6 ; KILL OFF TASK IF GBL VAL IS UNCHANGED FOR 60 SECONDS
IF M1=M2
DO KILLTASK^VENPCCP
+7 QUIT
+8 ;
NOVISIT ; EP-ENTRY POINT FOR GENERATING PCC+ FORMS WITHOUT CREATING A VISIT
+1 NEW NOVISIT
SET NOVISIT=1
+2 GOTO ^VENPCC
+3 ;
QUEUE(VISIT,DEPTIEN,OGFLAG,TRFLAG,UPDEM,PRVIEN) ; EP-UPDATE CHECKIN AND QUEUE FILES ; 2.5. ADD PARAMETER FOR PROVIDER
QSIG ; EP - SIGNATURE EP FOR ANMC
+1 IF '$DATA(^AUPNVSIT(+$GET(VISIT),0))
IF '$GET(NOVISIT)
QUIT
+2 IF $DATA(VENDEMO)
QUIT
+3 IF '$DATA(^VEN(7.95,+$GET(DEPTIEN),0))
QUIT
+4 NEW QTYPE,MIEN,QUE,DIG,DIH,DIU,DIV,DIW,DA,DR,DIE,DIC,X,Y,D0,D,DQ,DI,TIME,DLAYGO,DFN,%,VCN,INIT
+5 IF $GET(NOVISIT)
IF '$GET(PATIENT)
QUIT
SET DFN=PATIENT
SET TIME=$$NOW^VENPCCU
SET VISIT=""
GOTO MRQ
+6 IF VISIT[U
SET DFN=$PIECE(VISIT,U,2)
SET TIME=$PIECE(VISIT,U,3)
SET VISIT=""
GOTO MRQ
+7 SET X=^AUPNVSIT(VISIT,0)
+8 SET TIME=$$NOW^VENPCCU
+9 SET DFN=$PIECE(X,U,5)
SET PRVIEN=$GET(PRVIEN)
MRQ SET MIEN=$ORDER(^VEN(7.95,"B","MEDICAL RECORDS",0))
IF 'MIEN
QUIT
+1 IF $GET(OGFLAG)
SET QTYPE="MEDICAL RECORDS"
DO Q1
KILL QTYPE
+2 SET %=$PIECE($GET(^VEN(7.95,+$GET(DEPTIEN),1)),U,1+$GET(TRFLAG))
+3 IF %
SET QTYPE=$PIECE($GET(^VEN(7.22,%,0)),U)
+4 IF $LENGTH($GET(QTYPE))
DO Q1
+5 QUIT
+6 ;
Q1 ; EP-MAKE QUEUE FILE ENTRY
+1 SET DIC="^VEN(7.2,"
SET DIC(0)="L"
SET X=""""_TIME_""""
SET DLAYGO=19707.2
+2 DO ^DIC
IF Y=-1
QUIT
+3 SET DIE=DIC
SET DA=+Y
SET QUE=DA
+4 SET DR=".03///"_QTYPE_";.04////"_$SELECT(QTYPE="MEDICAL RECORDS":MIEN,1:+$GET(DEPTIEN))_";.06////"_DUZ
+5 SET DR=DR_";1.1////"_DFN_";1.2////"_VISIT_";.12////"_$PIECE($GET(^VEN(7.95,+$GET(DEPTIEN),0)),U,5)_";1.4////"_$GET(UPDEM)
+6 ; ADD PROVIDER INFO FOR VER 2.5
SET DR=DR_";1.5////"_PRVIEN_";1.6////"_$PIECE($GET(^AUPNVSIT(+$GET(VISIT),11)),U,3)
MOJO ; CLASSIC, DIGIPEN, OR TABLET
SET %=$GET(MOJOFLAG(1))
IF $LENGTH(%)
SET DR=DR_".13///"_$EXTRACT(%)
+1 LOCK +^VEN(7.2,DA):5
IF '$TEST
QUIT
+2 DO ^DIE
LOCK -^VEN(7.2,DA)
+3 QUIT
+4 ;
EXTCKIN(PATIENT) ; EP-CHECK IN ENTRY POINT FOR EXRTERNAL PACKAGES WHERE PATIENT IS KNOWN.
+1 ; IF PCC+ CHECKIN IS SUCCESSFUL, VISIT IEN IS RETURNED
+2 NEW CFIGIEN,CHECKIN
+3 SET CFIGIEN=$$CFG^VENPCCU
+4 SET CHECKIN=-1
+5 DO CLINIC
+6 IF CHECKIN=-1
QUIT ""
+7 QUIT CHECKIN
+8 ;
INIT(PRV) ; EP-RETURN THE PROVIDER'S INITIALS
+1 NEW X,INIT
+2 SET X=$GET(^VA(200,+$GET(PRV),0))
IF '$LENGTH(X)
QUIT ""
+3 ; CHOOSE BETWEEN INITIALS AND THE FULL NAME
SET INIT=$PIECE(X,U,2)
+4 ; CREATE INITIALS ON THE FLY
IF '$LENGTH(INIT)
IF $LENGTH($PIECE(X,U))
SET INIT=$EXTRACT($PIECE(X,",",2))_$EXTRACT(X)
+5 QUIT $EXTRACT(INIT,1,3)
+6 ;