VENPCCX ; IHS/OIT/GIS - EXTERNAL CALL TO PCC+ DATA EXTRACTOR ;
;;2.6;PCC+;;NOV 12, 2007
;
; ENTRY POINTS FOR , INFORMATIX BILLING PKG, VISIT PALNNING PKG, AND RPMS ER PKG
; 2.5 EXTENSIONS FOR THE SCHEDULING PKG (MULTIPLE VERSIONS)
;
IMP(STG,NOQ) ; EP-VISIT PLANNER ENTRY POINT
N DSTG,FLD,VAL,INIT,EXT,NIEN,TIME,PROV,EF,HS,DEPT,VISIT,VCN,VARS,%,DGBL
N X,Y,I,PCODE,DISCPL,NIEN16,NURSE,APPT,SPGRP,DEFEF,DEFHS,DEPTIEN,PRV
S DSTG="^VISIT^NURSE^PROV^EF^HS^DEPT^APPT^SPGRP^",INIT="",EXT="",DGBL=U_$C(68)_"IC(6)"
F I=1:1:$L(STG,U) S X=$P(STG,U,I) I $L(X) D
. S FLD=$P(X,";"),VAL=$P(X,";",2) I '$L(FLD) Q
. I DSTG[(U_FLD_U) S:$L(INIT) INIT=INIT_U S INIT=INIT_X Q
. I $L(EXT) S EXT=EXT_U
. S EXT=EXT_X
. Q
GET F I=1:1:$L(INIT,U) D
. S %=$P(INIT,U,I)
. S X=$P(%,";"),Y=$P(%,";",2,99)
. I $L(X) S @X=Y
. Q
S NIEN=+$G(NURSE)
I '$G(PROV) S PROV=$$GP^VENPCCU I 'PROV S PROV=-1
CHECK I $D(^AUPNVSIT(+$G(VISIT),0)),$D(^VA(200,+$G(NIEN),0)),$D(^VA(200,+$G(PROV),0)),$D(^VEN(7.41,+$G(EF),0)),$D(^VEN(7.95,+$G(DEPT),0))
E S ERR="INVALID/MISSING PARAMETERS IN VP STRING" D ERR^VENPCC1(ERR) Q -1
I $G(HS),'$D(^APCHSCTL(HS,0)) S ERR="INVALID HEALTH SUMMARY IDENTIFIER" D ERR^VENPCC1(ERR) Q -1
MORE S VCN=$P($G(^AUPNVSIT(VISIT,11)),U,3) I '$L(VCN) S ERR="MISSING VCN" D ERR^VENPCC1(ERR) Q -1
S TIME=$$NOW^VENPCCU
S APPT=+$G(APPT)
S NIEN16=$$PRV1^VENPCCU(NIEN) I 'NIEN16 Q -1
S PCODE=$P($G(@DGBL@(NIEN16,9999999)),U,2)
S %=+$P($G(@DGBL@(NIEN16,0)),U,4) S DISCPL=$P($G(^DIC(7,%,9999999)),U)
S EXT=EXT_U_"DISCPL"_";"_DISCPL_U_"PCODE"_";"_PCODE
S VARS="DUZ="_NIEN_U_"JOB="_$J_U_"DUZ(0)=@^DUZ(2)="_DUZ(2)
I HS=0 S HS="",VARS=VARS_U_"EFONLY=1"
I STG["^PROG;1^" S VARS=VARS_U_"OGFLAG=1"
I $G(SPGRP) S VARS=VARS_U_"SPGRP="_SPGRP
S DEFEF=$G(EF),DEFHS=$G(HS),PRV=$G(PROV),DEPTIEN=$G(DEPT)
RUN D EN1^VENPCCA("J",1) ; PRIMARY ENTRY PROINT FOR CREATING THE PCC+ DATASET
Q 1
;
EN(VIEN,DIEN,PIEN) ; EP FROM BILLING PACKAGE CHECK IN MODULE
S %=U_$C(68)_"IC(6)"
I $D(^AUPNVSIT(+$G(VIEN),0)),$D(^ABSBDEPT(+$G(DIEN),0)),$D(@%@(+$G(PIEN),0))
E W !,"Invalid registration parameters detected! No encounter form printed..." Q 0
NEW %,PATIENT,VCN,DEFEF,DEFHS,DIR,X,Y,PRVIEN,CFIGIEN,SBFLAG,APPT,VISIT
S DEPTIEN=+$P($G(^ABSBDEPT(DIEN,2)),U),VISIT=VIEN
I '$D(^VEN(7.95,DEPTIEN,0)) W !,"Invalid or missing department! No encounter form printed..."
I $P($G(^VEN(7.95,DEPTIEN,2)),U,7) Q 0 ; INACTIVE DEPT
S PATIENT=$P(^AUPNVSIT(VIEN,0),U,5)
I 'PATIENT W !,"Unable to locate a valid patient DFN! No encounter form printed..." Q 0
S VCN=$P($G(^AUPNVSIT(VIEN,11)),U,3)
I '$L(VCN) S VCN=$G(^AUPNVSIT(VIEN,"VCN"))
I '$L(VCN) W !,"Missing VCN! Visit terminated..." Q 0
S PRVIEN=$O(^VA(200,"A16",PIEN,0)) I 'PRVIEN W !,"Invalid provider IEN! No encounter form printed..."
S CFIGIEN=$$CFG^VENPCCU,SBFLAG=1,APPT=""
D EF^VENPCCA
Q 1
;
ABORT ; EP - DONT PRINT PCC+ FORMS
W !,"Request to print PCC+ forms cancelled!"
Q
;
SC(PRV,VISIT,VCN,CSIEN) ; EP-SCHEDULING PKG INTERFACE FROM ASDV
N %,%Y,CIEN,TOT,DEPT,CFIGIEN,DEPTIEN,DIC,X,Y,LOC,PGRP,VPFLAG,APPT,DEFEF,DEFHS,EFONLY,EXT,VARS,ELIG,TIME,DFN,%DT,DI,DISYS,DLAYGO
N IO,IOF,IOM,ION,IOS,IOST,IOT,IOXY,%E,POP
S PRV=+$$PRV^VENPCCU(+$G(PRV))
W !!,"Want to print PCC+ forms"
S %=1
I $G(DUZ(2))=1665,$G(CSIEN)=30 S %=2 ; ANMC PATCH
D YN^DICN I %'=1 Q
S CFIGIEN=$$CFG^VENPCCU
I $D(^DIC(40.7,+$G(CSIEN),0)),$D(^AUPNVSIT(+$G(VISIT),0)),$L($G(VCN)),CFIGIEN ; PATCHED IHS/ITSC/GIS 11/04/2004
E W !,"Missing/Invalid PCC+ parameters! Request cancelled..." Q
S (CIEN,TOT)=0
F Q:TOT>1 S CIEN=$O(^VEN(7.95,CIEN)) Q:'CIEN I $P($G(^VEN(7.95,CIEN,0)),U,4)=CSIEN S TOT=TOT+1,DEPT=CIEN
I TOT=1 S DEPTIEN=DEPT G:'$P($G(^VEN(7.5,+$G(DEPT),2)),U,7) EF
CLINIC S %=$P($G(^VEN(7.5,CFIGIEN,0)),U,6) I '% G CL1
I $P($G(^VEN(7.95,%,0)),U,4)=CSIEN,'$P(^(0),U,7) S Y=% G CL2
W !,"Invalid clinic stop! Request cancelled...",!
Q
;
CL1 ; EP - GET CLINIC
S DIC("A")="Clinic: "
S DIC("S")="I '$P(^(2),U,7),$P(^(0),U,4)=CSIEN"
S DIC="^VEN(7.95,",DIC(0)="AEQM",DLAYGO=19707.95 D ^DIC K DIC I Y=-1 D ABORT Q
CL2 ; EP - GET PRV
S DEPTIEN=+Y
I '$G(PRV) S PRV=$P($G(^VEN(7.95,DEPTIEN,2)),U,2) I 'PRV S PRV=$P($G(^VEN(7.5,CFIGIEN,0)),U,13)
I '$D(^VA(200,+$G(PRV),0)) W !,"Missing/invalid provider ID! Request cancelled..." Q
EF ; EP - DEFAULT ENCOUNTER FORM
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 D ABORT Q
S DEFEF=+Y
I $P($G(^VEN(7.95,DEPTIEN,2)),U,13) S DEFHS="" G VARS ; NEVER PRINT HEALTH SUMMARY IN THIS CLINIC
; PATCHED BY GIS/OIT 10/17/05 ; PCC+ 2.5 PATCH 1
HS ; EP - DEFAULT HEALTH SUMMARY ; PATCHED IHS/ITSC/GIS 11/04/2004
K DIC
S %=$P($G(^VEN(7.95,DEPTIEN,2)),U,6) I % S DIC("B")=$P($G(^APCHSCTL(%,0)),U)
S DIC("A")="Health Summary: "
S DIC(0)="AEQM",DIC="^APCHSCTL("
D ^DIC K DIC
I Y=-1 S EFONLY=1,DEFHS=""
E S DEFHS=+Y
VARS S APPT=$G(ASDDT),EXT=""
W !,"Submitting request for PCC+ Encounter Form...."
D QUEUE^VENPCCA(VISIT,DEPTIEN,"","","",PRV),DOCS^VENPCC ; 2.5 ADD PARAMETER FOR PROVIDER
TMAN I $D(NOTASK) D EN1^VENPCCA("D")
S VARS=$$PACK^VENPCC,EXT=$G(EXT)
D EN1^VENPCCA("J")
I $D(VPFLAG) K HSONLY,VPFLAG W !,"This information will be sent to the clinic..."
Q
;
SC53(VISIT,VCN,SDT) ; EP-SCHEDULING V5.3 INTERFACE FROM PROTOCOL
; VEN PRINT PCC+ ENCOUNTER FORM which is an item on protocol
; BSDAM APPOINTMENT EVENTS
; TO MAKE THE PCC+ DIALOGUE SHOW UP IN THE SCHEDULING CHECK IN PROCESS:
; THERE MUST BE A VISIT CREATED BY PIMS
; THE USER MUST HOLD THE 'VENZPRINT' KEY
; VER 5.3 OF PIMS MUST BE INSTALLED
; 'BSDAM APPOINTMENT EVENTS' & 'VEN PRINT PCC+ ENCOUNTER FORM' MUST BE IN THE PROTOCOL FILE
; 'VEN PRINT PCC+ ENCOUNTER FORM' MUST BE AN ITEM IN THE 'BSDAM APPOINTMENT EVENTS' PROTOCOL
Q:'$G(VISIT) Q:$G(VCN)=""
N CSIEN,PRV
S CSIEN=$P(^AUPNVSIT(VISIT,0),U,8)
S PRV=$O(^AUPNVPRV("AD",VISIT,-1))
S PRV=$P($G(^AUPNVPRV(+PRV,0)),U)
S ASDDT=SDT ; MAKES APPT DATE AVAILABLE
D SC^VENPCCX($G(PRV),$G(VISIT),$G(VCN),$G(CSIEN))
Q
;
ER(VISIT,VCN,DEPTIEN,PRV,DEFHS,DEFEF,ACT) ; EP-ENTRY POINT FOR THE ER PACKAGE
N OGONLY,HSONLY,EFONLY,%,OGFLAG,VARS,APPT
I PRV,DEFEF,DEFHS,VISIT,VCN
E Q 0
I ACT'["EF",ACT'["HS",ACT'["OG" Q 0
I ACT["OG" S OGFLAG=1
I ACT["EF",ACT["HS",ACT["OG" G ER1
I ACT'["EF",ACT'["HS" S OGONLY=1
I ACT'["EF" S HSONLY=1
I ACT'["HS" S EFONLY=1
ER1 S VARS=$$PACK^VENPCC,%="J",APPT=0
D EN1^VENPCCA(%)
Q 1
;
SS ; EP-SETUP THE SCHEDULING LINK
N X,Y,LINE1,LINE2
W !!,"Attempting to create the PCC+ link to the scheduling package..."
S X=$T(+2^ASDV),Y=$T(VISIT+67^ASDV)
I X[5.3 D SSP Q ; LINK TO SCHEDULING PKG VER 5.3
I Y["PCCPLUS" W !,"The PCC+ link to the IHS Scheduling Pkg is already present!",!,"Request cancelled..." Q
I X["5.0;",X["**5,7",Y["PCC"
E W !,"Unable to find the IHS Scheduling Package, Version 5.0, Patch 7 on you system",!,"Request cancelled!!" Q
S LINE1="PCCPLUS ; -- call to print PCC Encounter Form"
S LINE2=" I $L($T(SC^VENPCCX)) I $O(^VA(200,+$G(DUZ),51,""B"",+$O(^DIC(19.1,""B"",""VENZSCH"",0)),0)) D SC^VENPCCX($G(ASDPROV),$G(ASDVST),$G(ASDVCN),$G(ASDCC))"
D ZOSF^VENPCCU("ASDV","VISIT+67","LINE1","LINE2")
I $T(VISIT+68^ASDV)["VENZSCH" W !,"The link to the scheduling package has been successfully inserted!!" Q
W !,"Unable to insert the link to the scheduling package!! Request cancelled..."
Q
;
SSP ; EP-MAKE ENTRY IN THE PROTOCOL FILE FOR VER 5.3 OF SHCEDULING PKG
N X,PIEN,DIC,DIK,DA,Y
; S X="PCC+ 2.5",PIEN=$O(^DIC(9.4,"B","PCC+ 2.5",0)) I 'PIEN Q ; VEN PACKAGE DOESNT EXIST
S X="VEN PRINT PCC+ ENCOUNTER FORM"
I $D(^ORD(101,"B",X)) Q ; ALREADY EXISTS
I '$D(^ORD(101)) W !,"Can't find the PROTOCOL file" Q
S DIC="^ORD(101,",DIC(0)="L",DLAYGO=101
D ^DIC I Y=-1 Q
S DA=+Y,DIK=DIC
S ^ORD(101,DA,0)="VEN PRINT PCC+ ENCOUNTER FORM^Print PCC+ form at check-in^^A^"_DUZ_"^^^^^^^"_PIEN
S ^ORD(101,DA,1,0)="^^4^4^"_DT_U
S ^ORD(101,DA,1,1,0)="IHS protocol called by the Scheduling Event Driver (BSDAM APPOINTMENT"
S ^ORD(101,DA,1,2,0)="EVENTS). This protocol will print PCC+ Encounter Forms at check-in if the"
S ^ORD(101,DA,1,3,0)="proper parameters are set for the clinic involved, and PCC + is installed,"
S ^ORD(101,DA,1,4,0)="and the user has the 'VENZPRINT' security key."
S ^ORD(101,DA,20)="I $G(SDAMEVT)=4,$D(^XUSEC(""VENZPRINT"",DUZ)) D SC53^VENPCCX($G(BSDVSTN),$G(BSDVCN),$G(SDT))"
S ^ORD(101,DA,24)=""
S ^ORD(101,DA,99)=$H
D IX1^DIK
W !,"The Scheduling Pkg protocol has been installed"
Q
;
VENPCCX ; IHS/OIT/GIS - EXTERNAL CALL TO PCC+ DATA EXTRACTOR ;
+1 ;;2.6;PCC+;;NOV 12, 2007
+2 ;
+3 ; ENTRY POINTS FOR , INFORMATIX BILLING PKG, VISIT PALNNING PKG, AND RPMS ER PKG
+4 ; 2.5 EXTENSIONS FOR THE SCHEDULING PKG (MULTIPLE VERSIONS)
+5 ;
IMP(STG,NOQ) ; EP-VISIT PLANNER ENTRY POINT
+1 NEW DSTG,FLD,VAL,INIT,EXT,NIEN,TIME,PROV,EF,HS,DEPT,VISIT,VCN,VARS,%,DGBL
+2 NEW X,Y,I,PCODE,DISCPL,NIEN16,NURSE,APPT,SPGRP,DEFEF,DEFHS,DEPTIEN,PRV
+3 SET DSTG="^VISIT^NURSE^PROV^EF^HS^DEPT^APPT^SPGRP^"
SET INIT=""
SET EXT=""
SET DGBL=U_$CHAR(68)_"IC(6)"
+4 FOR I=1:1:$LENGTH(STG,U)
SET X=$PIECE(STG,U,I)
IF $LENGTH(X)
Begin DoDot:1
+5 SET FLD=$PIECE(X,";")
SET VAL=$PIECE(X,";",2)
IF '$LENGTH(FLD)
QUIT
+6 IF DSTG[(U_FLD_U)
IF $LENGTH(INIT)
SET INIT=INIT_U
SET INIT=INIT_X
QUIT
+7 IF $LENGTH(EXT)
SET EXT=EXT_U
+8 SET EXT=EXT_X
+9 QUIT
End DoDot:1
GET FOR I=1:1:$LENGTH(INIT,U)
Begin DoDot:1
+1 SET %=$PIECE(INIT,U,I)
+2 SET X=$PIECE(%,";")
SET Y=$PIECE(%,";",2,99)
+3 IF $LENGTH(X)
SET @X=Y
+4 QUIT
End DoDot:1
+5 SET NIEN=+$GET(NURSE)
+6 IF '$GET(PROV)
SET PROV=$$GP^VENPCCU
IF 'PROV
SET PROV=-1
CHECK IF $DATA(^AUPNVSIT(+$GET(VISIT),0))
IF $DATA(^VA(200,+$GET(NIEN),0))
IF $DATA(^VA(200,+$GET(PROV),0))
IF $DATA(^VEN(7.41,+$GET(EF),0))
IF $DATA(^VEN(7.95,+$GET(DEPT),0))
+1 IF '$TEST
SET ERR="INVALID/MISSING PARAMETERS IN VP STRING"
DO ERR^VENPCC1(ERR)
QUIT -1
+2 IF $GET(HS)
IF '$DATA(^APCHSCTL(HS,0))
SET ERR="INVALID HEALTH SUMMARY IDENTIFIER"
DO ERR^VENPCC1(ERR)
QUIT -1
MORE SET VCN=$PIECE($GET(^AUPNVSIT(VISIT,11)),U,3)
IF '$LENGTH(VCN)
SET ERR="MISSING VCN"
DO ERR^VENPCC1(ERR)
QUIT -1
+1 SET TIME=$$NOW^VENPCCU
+2 SET APPT=+$GET(APPT)
+3 SET NIEN16=$$PRV1^VENPCCU(NIEN)
IF 'NIEN16
QUIT -1
+4 SET PCODE=$PIECE($GET(@DGBL@(NIEN16,9999999)),U,2)
+5 SET %=+$PIECE($GET(@DGBL@(NIEN16,0)),U,4)
SET DISCPL=$PIECE($GET(^DIC(7,%,9999999)),U)
+6 SET EXT=EXT_U_"DISCPL"_";"_DISCPL_U_"PCODE"_";"_PCODE
+7 SET VARS="DUZ="_NIEN_U_"JOB="_$JOB_U_"DUZ(0)=@^DUZ(2)="_DUZ(2)
+8 IF HS=0
SET HS=""
SET VARS=VARS_U_"EFONLY=1"
+9 IF STG["^PROG;1^"
SET VARS=VARS_U_"OGFLAG=1"
+10 IF $GET(SPGRP)
SET VARS=VARS_U_"SPGRP="_SPGRP
+11 SET DEFEF=$GET(EF)
SET DEFHS=$GET(HS)
SET PRV=$GET(PROV)
SET DEPTIEN=$GET(DEPT)
RUN ; PRIMARY ENTRY PROINT FOR CREATING THE PCC+ DATASET
DO EN1^VENPCCA("J",1)
+1 QUIT 1
+2 ;
EN(VIEN,DIEN,PIEN) ; EP FROM BILLING PACKAGE CHECK IN MODULE
+1 SET %=U_$CHAR(68)_"IC(6)"
+2 IF $DATA(^AUPNVSIT(+$GET(VIEN),0))
IF $DATA(^ABSBDEPT(+$GET(DIEN),0))
IF $DATA(@%@(+$GET(PIEN),0))
+3 IF '$TEST
WRITE !,"Invalid registration parameters detected! No encounter form printed..."
QUIT 0
+4 NEW %,PATIENT,VCN,DEFEF,DEFHS,DIR,X,Y,PRVIEN,CFIGIEN,SBFLAG,APPT,VISIT
+5 SET DEPTIEN=+$PIECE($GET(^ABSBDEPT(DIEN,2)),U)
SET VISIT=VIEN
+6 IF '$DATA(^VEN(7.95,DEPTIEN,0))
WRITE !,"Invalid or missing department! No encounter form printed..."
+7 ; INACTIVE DEPT
IF $PIECE($GET(^VEN(7.95,DEPTIEN,2)),U,7)
QUIT 0
+8 SET PATIENT=$PIECE(^AUPNVSIT(VIEN,0),U,5)
+9 IF 'PATIENT
WRITE !,"Unable to locate a valid patient DFN! No encounter form printed..."
QUIT 0
+10 SET VCN=$PIECE($GET(^AUPNVSIT(VIEN,11)),U,3)
+11 IF '$LENGTH(VCN)
SET VCN=$GET(^AUPNVSIT(VIEN,"VCN"))
+12 IF '$LENGTH(VCN)
WRITE !,"Missing VCN! Visit terminated..."
QUIT 0
+13 SET PRVIEN=$ORDER(^VA(200,"A16",PIEN,0))
IF 'PRVIEN
WRITE !,"Invalid provider IEN! No encounter form printed..."
+14 SET CFIGIEN=$$CFG^VENPCCU
SET SBFLAG=1
SET APPT=""
+15 DO EF^VENPCCA
+16 QUIT 1
+17 ;
ABORT ; EP - DONT PRINT PCC+ FORMS
+1 WRITE !,"Request to print PCC+ forms cancelled!"
+2 QUIT
+3 ;
SC(PRV,VISIT,VCN,CSIEN) ; EP-SCHEDULING PKG INTERFACE FROM ASDV
+1 NEW %,%Y,CIEN,TOT,DEPT,CFIGIEN,DEPTIEN,DIC,X,Y,LOC,PGRP,VPFLAG,APPT,DEFEF,DEFHS,EFONLY,EXT,VARS,ELIG,TIME,DFN,%DT,DI,DISYS,DLAYGO
+2 NEW IO,IOF,IOM,ION,IOS,IOST,IOT,IOXY,%E,POP
+3 SET PRV=+$$PRV^VENPCCU(+$GET(PRV))
+4 WRITE !!,"Want to print PCC+ forms"
+5 SET %=1
+6 ; ANMC PATCH
IF $GET(DUZ(2))=1665
IF $GET(CSIEN)=30
SET %=2
+7 DO YN^DICN
IF %'=1
QUIT
+8 SET CFIGIEN=$$CFG^VENPCCU
+9 ; PATCHED IHS/ITSC/GIS 11/04/2004
IF $DATA(^DIC(40.7,+$GET(CSIEN),0))
IF $DATA(^AUPNVSIT(+$GET(VISIT),0))
IF $LENGTH($GET(VCN))
IF CFIGIEN
+10 IF '$TEST
WRITE !,"Missing/Invalid PCC+ parameters! Request cancelled..."
QUIT
+11 SET (CIEN,TOT)=0
+12 FOR
IF TOT>1
QUIT
SET CIEN=$ORDER(^VEN(7.95,CIEN))
IF 'CIEN
QUIT
IF $PIECE($GET(^VEN(7.95,CIEN,0)),U,4)=CSIEN
SET TOT=TOT+1
SET DEPT=CIEN
+13 IF TOT=1
SET DEPTIEN=DEPT
IF '$PIECE($GET(^VEN(7.5,+$GET(DEPT),2)),U,7)
GOTO EF
CLINIC SET %=$PIECE($GET(^VEN(7.5,CFIGIEN,0)),U,6)
IF '%
GOTO CL1
+1 IF $PIECE($GET(^VEN(7.95,%,0)),U,4)=CSIEN
IF '$PIECE(^(0),U,7)
SET Y=%
GOTO CL2
+2 WRITE !,"Invalid clinic stop! Request cancelled...",!
+3 QUIT
+4 ;
CL1 ; EP - GET CLINIC
+1 SET DIC("A")="Clinic: "
+2 SET DIC("S")="I '$P(^(2),U,7),$P(^(0),U,4)=CSIEN"
+3 SET DIC="^VEN(7.95,"
SET DIC(0)="AEQM"
SET DLAYGO=19707.95
DO ^DIC
KILL DIC
IF Y=-1
DO ABORT
QUIT
CL2 ; EP - GET PRV
+1 SET DEPTIEN=+Y
+2 IF '$GET(PRV)
SET PRV=$PIECE($GET(^VEN(7.95,DEPTIEN,2)),U,2)
IF 'PRV
SET PRV=$PIECE($GET(^VEN(7.5,CFIGIEN,0)),U,13)
+3 IF '$DATA(^VA(200,+$GET(PRV),0))
WRITE !,"Missing/invalid provider ID! Request cancelled..."
QUIT
EF ; EP - DEFAULT ENCOUNTER FORM
+1 SET %=+$PIECE($GET(^VEN(7.95,DEPTIEN,2)),U,5)
SET DIC("B")=$PIECE($GET(^VEN(7.41,%,0)),U)
+2 SET DIC("A")="Encounter form: "
+3 SET DIC(0)="AEQM"
SET DIC="^VEN(7.41,"
+4 DO ^DIC
KILL DIC
+5 IF Y=-1
DO ABORT
QUIT
+6 SET DEFEF=+Y
+7 ; NEVER PRINT HEALTH SUMMARY IN THIS CLINIC
IF $PIECE($GET(^VEN(7.95,DEPTIEN,2)),U,13)
SET DEFHS=""
GOTO VARS
+8 ; PATCHED BY GIS/OIT 10/17/05 ; PCC+ 2.5 PATCH 1
HS ; EP - DEFAULT HEALTH SUMMARY ; PATCHED IHS/ITSC/GIS 11/04/2004
+1 KILL DIC
+2 SET %=$PIECE($GET(^VEN(7.95,DEPTIEN,2)),U,6)
IF %
SET DIC("B")=$PIECE($GET(^APCHSCTL(%,0)),U)
+3 SET DIC("A")="Health Summary: "
+4 SET DIC(0)="AEQM"
SET DIC="^APCHSCTL("
+5 DO ^DIC
KILL DIC
+6 IF Y=-1
SET EFONLY=1
SET DEFHS=""
+7 IF '$TEST
SET DEFHS=+Y
VARS SET APPT=$GET(ASDDT)
SET EXT=""
+1 WRITE !,"Submitting request for PCC+ Encounter Form...."
+2 ; 2.5 ADD PARAMETER FOR PROVIDER
DO QUEUE^VENPCCA(VISIT,DEPTIEN,"","","",PRV)
DO DOCS^VENPCC
TMAN IF $DATA(NOTASK)
DO EN1^VENPCCA("D")
+1 SET VARS=$$PACK^VENPCC
SET EXT=$GET(EXT)
+2 DO EN1^VENPCCA("J")
+3 IF $DATA(VPFLAG)
KILL HSONLY,VPFLAG
WRITE !,"This information will be sent to the clinic..."
+4 QUIT
+5 ;
SC53(VISIT,VCN,SDT) ; EP-SCHEDULING V5.3 INTERFACE FROM PROTOCOL
+1 ; VEN PRINT PCC+ ENCOUNTER FORM which is an item on protocol
+2 ; BSDAM APPOINTMENT EVENTS
+3 ; TO MAKE THE PCC+ DIALOGUE SHOW UP IN THE SCHEDULING CHECK IN PROCESS:
+4 ; THERE MUST BE A VISIT CREATED BY PIMS
+5 ; THE USER MUST HOLD THE 'VENZPRINT' KEY
+6 ; VER 5.3 OF PIMS MUST BE INSTALLED
+7 ; 'BSDAM APPOINTMENT EVENTS' & 'VEN PRINT PCC+ ENCOUNTER FORM' MUST BE IN THE PROTOCOL FILE
+8 ; 'VEN PRINT PCC+ ENCOUNTER FORM' MUST BE AN ITEM IN THE 'BSDAM APPOINTMENT EVENTS' PROTOCOL
+9 IF '$GET(VISIT)
QUIT
IF $GET(VCN)=""
QUIT
+10 NEW CSIEN,PRV
+11 SET CSIEN=$PIECE(^AUPNVSIT(VISIT,0),U,8)
+12 SET PRV=$ORDER(^AUPNVPRV("AD",VISIT,-1))
+13 SET PRV=$PIECE($GET(^AUPNVPRV(+PRV,0)),U)
+14 ; MAKES APPT DATE AVAILABLE
SET ASDDT=SDT
+15 DO SC^VENPCCX($GET(PRV),$GET(VISIT),$GET(VCN),$GET(CSIEN))
+16 QUIT
+17 ;
ER(VISIT,VCN,DEPTIEN,PRV,DEFHS,DEFEF,ACT) ; EP-ENTRY POINT FOR THE ER PACKAGE
+1 NEW OGONLY,HSONLY,EFONLY,%,OGFLAG,VARS,APPT
+2 IF PRV
IF DEFEF
IF DEFHS
IF VISIT
IF VCN
+3 IF '$TEST
QUIT 0
+4 IF ACT'["EF"
IF ACT'["HS"
IF ACT'["OG"
QUIT 0
+5 IF ACT["OG"
SET OGFLAG=1
+6 IF ACT["EF"
IF ACT["HS"
IF ACT["OG"
GOTO ER1
+7 IF ACT'["EF"
IF ACT'["HS"
SET OGONLY=1
+8 IF ACT'["EF"
SET HSONLY=1
+9 IF ACT'["HS"
SET EFONLY=1
ER1 SET VARS=$$PACK^VENPCC
SET %="J"
SET APPT=0
+1 DO EN1^VENPCCA(%)
+2 QUIT 1
+3 ;
SS ; EP-SETUP THE SCHEDULING LINK
+1 NEW X,Y,LINE1,LINE2
+2 WRITE !!,"Attempting to create the PCC+ link to the scheduling package..."
+3 SET X=$TEXT(+2^ASDV)
SET Y=$TEXT(VISIT+67^ASDV)
+4 ; LINK TO SCHEDULING PKG VER 5.3
IF X[5.3
DO SSP
QUIT
+5 IF Y["PCCPLUS"
WRITE !,"The PCC+ link to the IHS Scheduling Pkg is already present!",!,"Request cancelled..."
QUIT
+6 IF X["5.0;"
IF X["**5,7"
IF Y["PCC"
+7 IF '$TEST
WRITE !,"Unable to find the IHS Scheduling Package, Version 5.0, Patch 7 on you system",!,"Request cancelled!!"
QUIT
+8 SET LINE1="PCCPLUS ; -- call to print PCC Encounter Form"
+9 SET LINE2=" I $L($T(SC^VENPCCX)) I $O(^VA(200,+$G(DUZ),51,""B"",+$O(^DIC(19.1,""B"",""VENZSCH"",0)),0)) D SC^VENPCCX($G(ASDPROV),$G(ASDVST),$G(ASDVCN),$G(ASDCC))"
+10 DO ZOSF^VENPCCU("ASDV","VISIT+67","LINE1","LINE2")
+11 IF $TEXT(VISIT+68^ASDV)["VENZSCH"
WRITE !,"The link to the scheduling package has been successfully inserted!!"
QUIT
+12 WRITE !,"Unable to insert the link to the scheduling package!! Request cancelled..."
+13 QUIT
+14 ;
SSP ; EP-MAKE ENTRY IN THE PROTOCOL FILE FOR VER 5.3 OF SHCEDULING PKG
+1 NEW X,PIEN,DIC,DIK,DA,Y
+2 ; S X="PCC+ 2.5",PIEN=$O(^DIC(9.4,"B","PCC+ 2.5",0)) I 'PIEN Q ; VEN PACKAGE DOESNT EXIST
+3 SET X="VEN PRINT PCC+ ENCOUNTER FORM"
+4 ; ALREADY EXISTS
IF $DATA(^ORD(101,"B",X))
QUIT
+5 IF '$DATA(^ORD(101))
WRITE !,"Can't find the PROTOCOL file"
QUIT
+6 SET DIC="^ORD(101,"
SET DIC(0)="L"
SET DLAYGO=101
+7 DO ^DIC
IF Y=-1
QUIT
+8 SET DA=+Y
SET DIK=DIC
+9 SET ^ORD(101,DA,0)="VEN PRINT PCC+ ENCOUNTER FORM^Print PCC+ form at check-in^^A^"_DUZ_"^^^^^^^"_PIEN
+10 SET ^ORD(101,DA,1,0)="^^4^4^"_DT_U
+11 SET ^ORD(101,DA,1,1,0)="IHS protocol called by the Scheduling Event Driver (BSDAM APPOINTMENT"
+12 SET ^ORD(101,DA,1,2,0)="EVENTS). This protocol will print PCC+ Encounter Forms at check-in if the"
+13 SET ^ORD(101,DA,1,3,0)="proper parameters are set for the clinic involved, and PCC + is installed,"
+14 SET ^ORD(101,DA,1,4,0)="and the user has the 'VENZPRINT' security key."
+15 SET ^ORD(101,DA,20)="I $G(SDAMEVT)=4,$D(^XUSEC(""VENZPRINT"",DUZ)) D SC53^VENPCCX($G(BSDVSTN),$G(BSDVCN),$G(SDT))"
+16 SET ^ORD(101,DA,24)=""
+17 SET ^ORD(101,DA,99)=$HOROLOG
+18 DO IX1^DIK
+19 WRITE !,"The Scheduling Pkg protocol has been installed"
+20 QUIT
+21 ;
