- 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 ;