VENPCCIT ; IHS/OIT/GIS - INSTALLATION TOOLS: ADD A NEW TEMPLATE FOR VER 2.5 ;
;;2.6;PCC+;;NOV 12, 2007
;
;
;
N DIC,DA,DIK,DIR,X,Y,Z,%,%Y,VER25,RXFLAG,SEP,TIEN,FLD,TMN,TNM,GGIEN,KNM,KIEN
INIT S VER25=+$P($G(^VEN(7.5,$$CFG^VENPCCU,13)),U) ; PCC+ IS CONFIGURED FOR VER 2.5
S SEP="----------------"
S RXFLAG=0
S X=$O(^PSRX("AD",9999999),-1) I X,$$FMDIFF^XLFDT(DT,X)<7 S RXFLAG=1 ; PHARMACY PKG IS IN ACTIVE USE
OLD K DIR,Y
S DIR(0)="S^1:Add a new template;2:Edit an existing template;3:Delete an existing template;4:Exit",DIR("A")="Your choice"
D ^DIR K DIR
I 'Y!(Y=4) D ^XBFMK Q
I Y'=1 S TIEN=$$LKUP Q:TIEN="" S (TNM,FLD(.01))=$P($G(^VEN(7.41,TIEN,0)),U) ; GET TEMPLATE IEN AND NAME
I Y=3 D DT(TIEN) G OLD ; DELETE A CLINIC
I Y=2 G TEDIT ; EDIT A CLINIC
NAME ; TEMPLATE NAME
W !!,"Enter the NAME of the new PCC+ template."
W !,"This is the name that will be seen during the check-in process."
W !,"Naming conventions-> "
W !?3,"If your PCC+ system is used (& will be used) in only one facility:"
W !?5,"<CLINIC NAME>"
W !?5,"Examples: 'PODIATRY', or 'WALKIN'"
W !?3,"Otherwise, if your PCC+ system covers multiple facilities: "
W !?5,"<BRIEF SITE NAME> <CLINIC NAME>"
W !?5,"Examples: 'ANMC NEUROLOGY' or 'WARM SPRINGS MEDICAL'",!
W !?5,"Also, if you want to edit the properties of an existing template, enter the"
W !?5,"the EXACT, full name of that template now"
NAME1 S DIR("?")="Name must be 3-30 uppercase letters. Numbers and spaces OK also"
S DIR(0)="FO^3:30",DIR("A")="Template name" D ^DIR
I Y?1."^"!(Y="") G FIN
S X=$TR(Y," ","") S X=$TR(X,"(","") S X=$TR(X,")","") S X=$TR(X,"-","") I X'?3.30UN W " ??",!,DIR("?") G NAME1 ; NAME FAILED VALIDATION
S (TNM,FLD(.01))=Y
S Z=$O(^VEN(7.41,"B",TNM,0))
I 'Z G HMN
W !,"This template already exits. Try again" W !! G NAME1
;
TEDIT ; EP - EDIT TEMPLATE PROPERTIES ; TIEN MUST EXIT
HMN S FLD(.02)=25 ; HEADER MNEMONIC ; PATCHED BY GIS/OIT 10/15/05 ; PCC+ 2.5 PATCH 1
TMN ; TEMPLATE MNEMONIC
W !!,"Enter this template's mnemonic..."
W !?3,"The mnemonic is 1-10 lowercase characters/numbers"
W !?3,"It is the first part of this template's file name on the print server"
W !?3,"For example, 'neuro' is the mnemonic for the template 'neuro_template.doc"
TMN1 S DIR("?")="Name must be 1-10 lowercase letters. Imbedded numbers can be included as well."
S DIR(0)="F^1:10",DIR("A")="Template mnemonic"
S %=$O(^VEN(7.41,"B",FLD(.01),0))
I % S DIR("B")=$P($G(^VEN(7.41,%,0)),U,3)
D ^DIR
I Y=U G NAME1
I Y?2."^"!(Y="") G FIN
I Y'?1.10LN W " ??",!,DIR("?") G TMN1 ; MNEMONIC FAILED VALIDATION
S (TMN,FLD(.03))=Y
S DIC="^VEN(7.41,",DLAYGO=19707.41,DIC(0)="L"
S X=FLD(.01)
D ^DIC I Y=-1 W !!,"Update failed!" G FIN
S (DA,TIEN)=+Y
S DIE=DIC,DR=".02////^S X=FLD(.02);.03////^S X=FLD(.03)"
L +^VEN(7.41,TIEN):0 I D ^DIE L -^VEN(7.41,TIEN)
K FLD
DX ; ICD PREFERENCES ; PATCHED BY GIS/OIT 10/15/05 ; PCC+ 2.5 PATCH 1
W !!,SEP," ICD PREFERENCES ",SEP
DX1 W !!,"Does this form contain Dx mail merge fields (ICD preferences)"
S %=1
D YN^DICN I %Y?1."^" G FIN
I %=2 S FLD(1.2)="@" G DXDIE
DX2 W !!,"Count the number of Dx mail merge fields on this form"
K DIR S DIR(0)="NO^1:60:0",DIR("A")="How many are there",DIR("B")="50"
S %=$P($G(^VEN(7.41,TIEN,1)),U,2) I % S DIR("B")=%
S %=$G(FLD(1.2)) I % S DIR("B")=%
D ^DIR
I Y=U G DX
I Y?2."^" G FIN
S FLD(1.2)=+Y
DXDIE D DIE(TIEN)
MSR ; MEASUREMENTS
W !!,SEP," MEASUREMENTS ",SEP
MSR1 W !!,"Does this form contain measurements"
S %=1
D YN^DICN
I %Y=U W !!,SEP G DX
I %Y?2."^" G FIN
I %=2 D G MSRDIE
. F %=.15,14.07,14.08 S FLD(%)="@" ; GENERAL CLEANUP
. Q
MSR2 W !,"Specify default measurement units ->"
K DIR S DIR(0)="SO^0:NEVER METRIC;1:ALWAYS METRIC;2:METRIC UNTIL AGE 1",DIR("A")="Units",DIR("B")="NEVER METRIC"
S %=$P($G(^VEN(7.41,TIEN,0)),U,15) I %'="" S DIR("B")=%
I $L($G(FLD(.15))) S DIR("B")=FLD(.15)
D ^DIR
I Y="" G POV
I Y=U G MSR1
I Y?2."^" G FIN
S FLD(.15)=Y
MSR3 W !!,"Will the Nurse Check-in Module be used with this form"
S %=2
I $P($G(^VEN(7.41,TIEN,14)),U,7) S %=1
S Z=$G(FLD(14.7)) I $L(Z) S %=$S(Z=1:1,1:2)
D YN^DICN
I %Y=U G MSR2
I %Y?2."^" G FIN
S FLD(14.07)=$S(%=1:1,1:0)
I %'=1 S FLD(14.08)="@" G MSRDIE
MSR4 W !!,"Specify the max length of the Chief Complaint narrative allowed on this form"
K DIR S DIR(0)="NO^1:240:0",DIR("A")="Maximum length",DIR("B")="240"
S %=$P($G(^VEN(7.41,TIEN,14)),U,8) I % S DIR("B")=%
D ^DIR
I Y=U G MSR3
I Y?2."^" G FIN
S FLD(14.08)=Y
MSRDIE D DIE(TIEN)
POV ; POVS AND PROBLEMS
W !!,SEP," POVS AND PROBLEMS ",SEP
POV1 W !!,"Does this form contain POVs and/or Active Problems"
S %=1 D YN^DICN
I %Y=U W !!,SEP G MSR
I %Y?2."^" G FIN
I %=2 D G POVDIE
. F %=1.1,2.12,5.21,2.13,5.15,5.16 S FLD(%)="@"
. Q
POVN ; MAX NO OF POVS ; PATCHED BY GIS/OIT 10/15/05 ; PCC+ 2.5 PATCH 1
W !!,"Count the number of PROBLEM/POV mail merge fields on this form"
K DIR S DIR(0)="NO^1:60:0",DIR("A")="How many are there",DIR("B")="20"
S %=$P($G(^VEN(7.41,TIEN,1)),U,1) I % S DIR("B")=%
S %=$G(FLD(1.1)) I % S DIR("B")=%
D ^DIR
I Y=U G POV1
I Y?2."^" G FIN
S FLD(1.1)=+Y
POV2 W !!,"If the Onset Date has been stored in RPMS,",!,"want to display it with the POV/Problem"
S %=2
I $P($G(^VEN(7.41,TIEN,2)),U,12) S %=1
S Z=$G(FLD(2.12)) I $L(Z) S %=$S(Z=1:1,1:2)
D YN^DICN
I %Y=U G POVN
I %Y?2."^" G FIN
S FLD(2.12)=$S(%=1:1,1:0)
POV3 W !!,"If the Visit Control # (VCN) has been stored in RPMS,",!,"want to display it with the POV/Problem"
S %=2
I $P($G(^VEN(7.41,TIEN,5)),U,21) S %=1
S Z=$G(FLD(5.21)) I $L(Z) S %=$S(Z=1:1,1:2)
D YN^DICN
I %Y=U G POV2
I %Y?2."^" G FIN
S FLD(5.21)=$S(%=1:1,1:0)
POV4 W !!,"Show only PROBLEMS (no POVs) in the POV/Problem list"
S %=2
I $P($G(^VEN(7.41,TIEN,2)),U,13) S %=1
S Z=$G(FLD(2.13)) I $L(Z) S %=$S(Z=1:1,1:2)
D YN^DICN
I %Y=U G POV3
I %Y?2."^" G FIN
S FLD(2.13)=$S(%=1:1,1:0)
POV5 W !!,"Want to block the display of ICD codes entered at other facilities"
S %=2
I $P($G(^VEN(7.41,TIEN,5)),U,15) S %=1
S Z=$G(FLD(5.15)) I $L(Z) S %=$S(Z=1:1,1:2)
D YN^DICN
I %Y=U G POV4
I %Y?2."^" G FIN
S FLD(5.15)=$S(%=1:1,1:0)
POV6 K DIR S DIR("?")="You can extend the length of the provider narrative up to 80 characters"
W !!,DIR("?")
S DIR(0)="NO^1:80:0",DIR("A")="Maximum narrative length",DIR("B")="27"
S %=$P($G(^VEN(7.41,TIEN,5)),U,16) I % S DIR("B")=%
I $L($G(FLD(5.16))) S DIR("B")=FLD(5.16)
D ^DIR
I Y=U G POV5
I Y?2."^" G FIN
S FLD(5.16)=Y
POVDIE D DIE(TIEN) ; ENTER FIELD DATA INTO RPMS AND CLEAN OUT FLD ARRAY
RX ; PRESCRIPTIONS
W !!,SEP," PRESCRIPTIONS ",SEP
RX1 W !!,"Does this form contain a Prescription List"
S %=1 D YN^DICN
I %Y=U W !!,SEP G POV
I %Y?2."^" G FIN
I %=2 D G RXDIE
. F %=.12,.14,2.11,2.4,2.6,2.7,2.8,2.9,14.01,14.02,14.03,14.04,14.05 S FLD(%)="@"
. Q
RXN ; MAX RXS ; PATCHED BY GIS/OIT 10/15/05 ; PCC+ 2.5 PATCH 1
W !!,"Count the number of Rx mail merge fields on this form"
K DIR S DIR(0)="NO^1:60:0",DIR("A")="How many are there",DIR("B")="15"
S %=$P($G(^VEN(7.41,TIEN,2)),U,4) I % S DIR("B")=%
S %=$G(FLD(2.4)) I % S DIR("B")=%
D ^DIR
I Y=U G RX1
I Y?2."^" G FIN
S FLD(2.4)=+Y
RX2 W !!,"You can limit the time that a drug is displayed beyond it run-out date"
K DIR S DIR(0)="NO^1:999:0",DIR("A")="Maximum display duration (days)",DIR("B")="75"
S %=$P($G(^VEN(7.41,TIEN,2)),U,6) I % S DIR("B")=%
I $L($G(FLD(2.6))) S DIR("B")=FLD(2.6)
D ^DIR
I Y=U G RXN
I Y?2."^" G FIN
I Y S FLD(2.6)=Y
RX3 W !!,"Want to display only active prescriptions"
S %=2
I $P($G(^VEN(7.41,TIEN,2)),U,8) S %=1
S Z=$G(FLD(2.8)) I $L(Z) S %=$S(Z=1:1,1:2)
D YN^DICN
I %Y=U G RX2
I %Y?2."^" G FIN
S FLD(2.8)=$S(%=1:1,1:0)
RX4 W !!,"Want to hide redundant prescriptions"
S %=2
I $P($G(^VEN(7.41,TIEN,2)),U,9) S %=1
S Z=$G(FLD(2.9)) I $L(Z) S %=$S(Z=1:1,1:2)
D YN^DICN
I %Y=U G RX3
I %Y?2."^" G FIN
S FLD(2.9)=$S(%=1:1,1:0)
W !!,"You can now specify the max length of the RX and its components."
RX5 K DIR S DIR(0)="NO^1:80:0",DIR("A")="Max length of Medication name",DIR("B")="30"
S %=$P($G(^VEN(7.41,TIEN,14)),U,2) I % S DIR("B")=%
I $L($G(FLD(14.02))) S DIR("B")=FLD(14.02)
D ^DIR
I Y=U G RX2
I Y?2."^" G FIN
I Y S FLD(14.02)=Y
RX6 K DIR S DIR(0)="NO^1:199:0",DIR("A")="Max length of Sig",DIR("B")="40"
S %=$P($G(^VEN(7.41,TIEN,14)),U,3) I % S DIR("B")=%
I $L($G(FLD(14.03))) S DIR("B")=FLD(14.03)
D ^DIR
I Y=U G RX5
I Y?2."^" G FIN
I Y S FLD(14.03)=Y
; I 'RXFLAG G RX14
RX8 K DIR S DIR(0)="NO^1:999:0",DIR("A")="Max length of entire prescription",DIR("B")="30"
S %=$P($G(^VEN(7.41,TIEN,14)),U) I % S DIR("B")=%
I $L($G(FLD(14.01))) S DIR("B")=FLD(14.01)
D ^DIR
I Y=U G RX6
I Y?2."^" G FIN
I Y S FLD(14.01)=Y
RX9 W !!,"Want to hide the Rx reminder note"
S %=2
I $P($G(^VEN(7.41,TIEN,0)),U,12) S %=1
S Z=$G(FLD(.12)) I $L(Z) S %=$S(Z=1:1,1:2)
D YN^DICN
I %Y=U G RX8
I %Y?2."^" G FIN
S FLD(.12)=$S(%=1:1,1:0)
RX10 W !!,"Want to show the prescribing provider"
S %=2
I $P($G(^VEN(7.41,TIEN,0)),U,14) S %=1
S Z=$G(FLD(.14)) I $L(Z) S %=$S(Z=1:1,1:2)
D YN^DICN
I %Y=U G RX9
I %Y?2."^" G FIN
S FLD(.14)=$S(%=1:1,1:0)
RX11 W !!,"Want to display the Rx issue date"
S %=2
I $P($G(^VEN(7.41,TIEN,2)),U,11) S %=1
S Z=$G(FLD(2.11)) I $L(Z) S %=$S(Z=1:1,1:2)
D YN^DICN
I %Y=U G RX10
I %Y?2."^" G FIN
S FLD(2.11)=$S(%=1:1,1:0)
RX12 W !!,"Want to show chronic meds only"
S %=2
I $P($G(^VEN(7.41,TIEN,2)),U,7) S %=1
S Z=$G(FLD(2.7)) I $L(Z) S %=$S(Z=1:1,1:2)
D YN^DICN
I %Y=U G RX11
I %Y?2."^" G FIN
S FLD(2.7)=$S(%=1:1,1:0)
RX13 W !!,"Want to sort the list by 'chronic' & 'incidental' Rxs"
S %=2
I $P($G(^VEN(7.41,TIEN,14)),U,5) S %=1
D YN^DICN
I %Y=U G RX12
I %Y?2."^" G FIN
S FLD(14.05)=$S(%=1:1,1:0)
RXDIE D DIE(TIEN)
HMR ; EP - HEALTH MAINTENANCE REMINDERS
W !!,SEP," HEALTH MAINTENANCE REMINDERS ",SEP
HMR1 W !!,"Does this form contain reminders"
S %=1
D YN^DICN
I %Y=U W !!,SEP G RX
I %Y?2."^" G FIN
I %=2 D G HMRDIE
. F %=5.01,5.02,5.03,15.01,15.02 S FLD(%)="@" ; GENERAL CLEANUP
. Q
HMR2 W !!,"Want to use the new surveillance list - !RECOMMENDED!"
S %=1
I $P($G(^VEN(7.41,TIEN,5)),U)=0 S %=2
S Z=$G(FLD(5.01)) I $L(Z) S %=$S(Z=1:1,1:2)
D YN^DICN
I %Y=U G HMR1
I %Y?2."^" G FIN
S FLD(5.01)=$S(%=1:1,1:0)
HMR3 W !!,"When displaying reminders, hide last date & result"
S %=2
I $P($G(^VEN(7.41,TIEN,5)),U,2)=1 S %=1
S Z=$G(FLD(5.02)) I $L(Z) S %=$S(Z=1:1,1:2)
D YN^DICN
I %Y=U G HMR2
I %Y?2."^" G FIN
S FLD(5.02)=$S(%=1:1,1:0)
HMR4 W !!,"When displaying reminders, hide forecasts if not 'due now'"
S %=2
I $P($G(^VEN(7.41,TIEN,5)),U,3)=1 S %=1
S Z=$G(FLD(5.03)) I $L(Z) S %=$S(Z=1:1,1:2)
D YN^DICN
I %Y=U G HMR3
I %Y?2."^" G FIN
S FLD(5.03)=$S(%=1:1,1:0)
HMR5 W !!,"You can hide 'refusals' that are old or 'stale'."
K DIR S DIR(0)="NO^1:60:0"
S DIR("A")="Maximum age of a refusal (months)",DIR("B")="60"
S %=$P($G(^VEN(7.41,TIEN,15)),U) I % S DIR("B")=%
I $L($G(FLD(15.01))) S DIR("B")=FLD(15.01)
D ^DIR
I Y=U G HMR4
I Y?2."^" G FIN
I Y S FLD(15.01)=Y
HMR6 W !!,"Include patient education topics in the refusal list"
S %=2
I $P($G(^VEN(7.41,TIEN,15)),U,2)=1 S %=1
D YN^DICN
I %Y=U G HMR5
I %Y?2."^" G FIN
S FLD(15.02)=$S(%=1:1,1:0)
HMRDIE D DIE(TIEN)
G LAB^VENPCCIX ; CONTINUE IN VENPCCIX. THIS ROUTINE IS GETTING TOO LONG!!!
;
FIN D ^XBFMK ; EP - CLEANUP
Q
;
DT(DA) ; EP - DELETE A TEMPLATE
N DIC,DIK
I '$D(^VEN(7.41,+$G(DA),0)) Q ; NOTHING TO DELETE
W !!,"Are you sure you want to completely delete this template" S %=0
D YN^DICN
I %'=1 W !,"Nothing deleted..." D ^XBFMK Q
S DIK="^VEN(7.41,"
D ^DIK
W !,"Template deleted"
D ^XBFMK
Q
;
LKUP() ; EP - LOOK UP A PCC+ TEMPLATE
N DIC,X,Y,CIEN
S DIC="^VEN(7.41,"
S DIC(0)="AEQM"
W "PCC+ Template: "
D ^DIC
I Y=-1 S TIEN=""
E S TIEN=+Y
D ^XBFMK
Q TIEN
;
DIE(DA) ; EP - UPDATE FILEMAN FIELDS
N DR,DIE
S DIE="^VEN(7.41,"
S DR="",FLD=0
F S FLD=$O(FLD(FLD)) Q:'FLD D
. I $L(DR) S DR=DR_";"
. S DR=DR_FLD_"////^S X=FLD("_FLD_")"
. Q
L +^VEN(7.41,DA):0 I D ^DIE L -^VEN(7.41,DA)
K FLD
Q
;
VENPCCIT ; IHS/OIT/GIS - INSTALLATION TOOLS: ADD A NEW TEMPLATE FOR VER 2.5 ;
+1 ;;2.6;PCC+;;NOV 12, 2007
+2 ;
+3 ;
+4 ;
+5 NEW DIC,DA,DIK,DIR,X,Y,Z,%,%Y,VER25,RXFLAG,SEP,TIEN,FLD,TMN,TNM,GGIEN,KNM,KIEN
INIT ; PCC+ IS CONFIGURED FOR VER 2.5
SET VER25=+$PIECE($GET(^VEN(7.5,$$CFG^VENPCCU,13)),U)
+1 SET SEP="----------------"
+2 SET RXFLAG=0
+3 ; PHARMACY PKG IS IN ACTIVE USE
SET X=$ORDER(^PSRX("AD",9999999),-1)
IF X
IF $$FMDIFF^XLFDT(DT,X)<7
SET RXFLAG=1
OLD KILL DIR,Y
+1 SET DIR(0)="S^1:Add a new template;2:Edit an existing template;3:Delete an existing template;4:Exit"
SET DIR("A")="Your choice"
+2 DO ^DIR
KILL DIR
+3 IF 'Y!(Y=4)
DO ^XBFMK
QUIT
+4 ; GET TEMPLATE IEN AND NAME
IF Y'=1
SET TIEN=$$LKUP
IF TIEN=""
QUIT
SET (TNM,FLD(.01))=$PIECE($GET(^VEN(7.41,TIEN,0)),U)
+5 ; DELETE A CLINIC
IF Y=3
DO DT(TIEN)
GOTO OLD
+6 ; EDIT A CLINIC
IF Y=2
GOTO TEDIT
NAME ; TEMPLATE NAME
+1 WRITE !!,"Enter the NAME of the new PCC+ template."
+2 WRITE !,"This is the name that will be seen during the check-in process."
+3 WRITE !,"Naming conventions-> "
+4 WRITE !?3,"If your PCC+ system is used (& will be used) in only one facility:"
+5 WRITE !?5,"<CLINIC NAME>"
+6 WRITE !?5,"Examples: 'PODIATRY', or 'WALKIN'"
+7 WRITE !?3,"Otherwise, if your PCC+ system covers multiple facilities: "
+8 WRITE !?5,"<BRIEF SITE NAME> <CLINIC NAME>"
+9 WRITE !?5,"Examples: 'ANMC NEUROLOGY' or 'WARM SPRINGS MEDICAL'",!
+10 WRITE !?5,"Also, if you want to edit the properties of an existing template, enter the"
+11 WRITE !?5,"the EXACT, full name of that template now"
NAME1 SET DIR("?")="Name must be 3-30 uppercase letters. Numbers and spaces OK also"
+1 SET DIR(0)="FO^3:30"
SET DIR("A")="Template name"
DO ^DIR
+2 IF Y?1."^"!(Y="")
GOTO FIN
+3 ; NAME FAILED VALIDATION
SET X=$TRANSLATE(Y," ","")
SET X=$TRANSLATE(X,"(","")
SET X=$TRANSLATE(X,")","")
SET X=$TRANSLATE(X,"-","")
IF X'?3.30UN
WRITE " ??",!,DIR("?")
GOTO NAME1
+4 SET (TNM,FLD(.01))=Y
+5 SET Z=$ORDER(^VEN(7.41,"B",TNM,0))
+6 IF 'Z
GOTO HMN
+7 WRITE !,"This template already exits. Try again"
WRITE !!
GOTO NAME1
+8 ;
TEDIT ; EP - EDIT TEMPLATE PROPERTIES ; TIEN MUST EXIT
HMN ; HEADER MNEMONIC ; PATCHED BY GIS/OIT 10/15/05 ; PCC+ 2.5 PATCH 1
SET FLD(.02)=25
TMN ; TEMPLATE MNEMONIC
+1 WRITE !!,"Enter this template's mnemonic..."
+2 WRITE !?3,"The mnemonic is 1-10 lowercase characters/numbers"
+3 WRITE !?3,"It is the first part of this template's file name on the print server"
+4 WRITE !?3,"For example, 'neuro' is the mnemonic for the template 'neuro_template.doc"
TMN1 SET DIR("?")="Name must be 1-10 lowercase letters. Imbedded numbers can be included as well."
+1 SET DIR(0)="F^1:10"
SET DIR("A")="Template mnemonic"
+2 SET %=$ORDER(^VEN(7.41,"B",FLD(.01),0))
+3 IF %
SET DIR("B")=$PIECE($GET(^VEN(7.41,%,0)),U,3)
+4 DO ^DIR
+5 IF Y=U
GOTO NAME1
+6 IF Y?2."^"!(Y="")
GOTO FIN
+7 ; MNEMONIC FAILED VALIDATION
IF Y'?1.10LN
WRITE " ??",!,DIR("?")
GOTO TMN1
+8 SET (TMN,FLD(.03))=Y
+9 SET DIC="^VEN(7.41,"
SET DLAYGO=19707.41
SET DIC(0)="L"
+10 SET X=FLD(.01)
+11 DO ^DIC
IF Y=-1
WRITE !!,"Update failed!"
GOTO FIN
+12 SET (DA,TIEN)=+Y
+13 SET DIE=DIC
SET DR=".02////^S X=FLD(.02);.03////^S X=FLD(.03)"
+14 LOCK +^VEN(7.41,TIEN):0
IF $TEST
DO ^DIE
LOCK -^VEN(7.41,TIEN)
+15 KILL FLD
DX ; ICD PREFERENCES ; PATCHED BY GIS/OIT 10/15/05 ; PCC+ 2.5 PATCH 1
+1 WRITE !!,SEP," ICD PREFERENCES ",SEP
DX1 WRITE !!,"Does this form contain Dx mail merge fields (ICD preferences)"
+1 SET %=1
+2 DO YN^DICN
IF %Y?1."^"
GOTO FIN
+3 IF %=2
SET FLD(1.2)="@"
GOTO DXDIE
DX2 WRITE !!,"Count the number of Dx mail merge fields on this form"
+1 KILL DIR
SET DIR(0)="NO^1:60:0"
SET DIR("A")="How many are there"
SET DIR("B")="50"
+2 SET %=$PIECE($GET(^VEN(7.41,TIEN,1)),U,2)
IF %
SET DIR("B")=%
+3 SET %=$GET(FLD(1.2))
IF %
SET DIR("B")=%
+4 DO ^DIR
+5 IF Y=U
GOTO DX
+6 IF Y?2."^"
GOTO FIN
+7 SET FLD(1.2)=+Y
DXDIE DO DIE(TIEN)
MSR ; MEASUREMENTS
+1 WRITE !!,SEP," MEASUREMENTS ",SEP
MSR1 WRITE !!,"Does this form contain measurements"
+1 SET %=1
+2 DO YN^DICN
+3 IF %Y=U
WRITE !!,SEP
GOTO DX
+4 IF %Y?2."^"
GOTO FIN
+5 IF %=2
Begin DoDot:1
+6 ; GENERAL CLEANUP
FOR %=.15,14.07,14.08
SET FLD(%)="@"
+7 QUIT
End DoDot:1
GOTO MSRDIE
MSR2 WRITE !,"Specify default measurement units ->"
+1 KILL DIR
SET DIR(0)="SO^0:NEVER METRIC;1:ALWAYS METRIC;2:METRIC UNTIL AGE 1"
SET DIR("A")="Units"
SET DIR("B")="NEVER METRIC"
+2 SET %=$PIECE($GET(^VEN(7.41,TIEN,0)),U,15)
IF %'=""
SET DIR("B")=%
+3 IF $LENGTH($GET(FLD(.15)))
SET DIR("B")=FLD(.15)
+4 DO ^DIR
+5 IF Y=""
GOTO POV
+6 IF Y=U
GOTO MSR1
+7 IF Y?2."^"
GOTO FIN
+8 SET FLD(.15)=Y
MSR3 WRITE !!,"Will the Nurse Check-in Module be used with this form"
+1 SET %=2
+2 IF $PIECE($GET(^VEN(7.41,TIEN,14)),U,7)
SET %=1
+3 SET Z=$GET(FLD(14.7))
IF $LENGTH(Z)
SET %=$SELECT(Z=1:1,1:2)
+4 DO YN^DICN
+5 IF %Y=U
GOTO MSR2
+6 IF %Y?2."^"
GOTO FIN
+7 SET FLD(14.07)=$SELECT(%=1:1,1:0)
+8 IF %'=1
SET FLD(14.08)="@"
GOTO MSRDIE
MSR4 WRITE !!,"Specify the max length of the Chief Complaint narrative allowed on this form"
+1 KILL DIR
SET DIR(0)="NO^1:240:0"
SET DIR("A")="Maximum length"
SET DIR("B")="240"
+2 SET %=$PIECE($GET(^VEN(7.41,TIEN,14)),U,8)
IF %
SET DIR("B")=%
+3 DO ^DIR
+4 IF Y=U
GOTO MSR3
+5 IF Y?2."^"
GOTO FIN
+6 SET FLD(14.08)=Y
MSRDIE DO DIE(TIEN)
POV ; POVS AND PROBLEMS
+1 WRITE !!,SEP," POVS AND PROBLEMS ",SEP
POV1 WRITE !!,"Does this form contain POVs and/or Active Problems"
+1 SET %=1
DO YN^DICN
+2 IF %Y=U
WRITE !!,SEP
GOTO MSR
+3 IF %Y?2."^"
GOTO FIN
+4 IF %=2
Begin DoDot:1
+5 FOR %=1.1,2.12,5.21,2.13,5.15,5.16
SET FLD(%)="@"
+6 QUIT
End DoDot:1
GOTO POVDIE
POVN ; MAX NO OF POVS ; PATCHED BY GIS/OIT 10/15/05 ; PCC+ 2.5 PATCH 1
+1 WRITE !!,"Count the number of PROBLEM/POV mail merge fields on this form"
+2 KILL DIR
SET DIR(0)="NO^1:60:0"
SET DIR("A")="How many are there"
SET DIR("B")="20"
+3 SET %=$PIECE($GET(^VEN(7.41,TIEN,1)),U,1)
IF %
SET DIR("B")=%
+4 SET %=$GET(FLD(1.1))
IF %
SET DIR("B")=%
+5 DO ^DIR
+6 IF Y=U
GOTO POV1
+7 IF Y?2."^"
GOTO FIN
+8 SET FLD(1.1)=+Y
POV2 WRITE !!,"If the Onset Date has been stored in RPMS,",!,"want to display it with the POV/Problem"
+1 SET %=2
+2 IF $PIECE($GET(^VEN(7.41,TIEN,2)),U,12)
SET %=1
+3 SET Z=$GET(FLD(2.12))
IF $LENGTH(Z)
SET %=$SELECT(Z=1:1,1:2)
+4 DO YN^DICN
+5 IF %Y=U
GOTO POVN
+6 IF %Y?2."^"
GOTO FIN
+7 SET FLD(2.12)=$SELECT(%=1:1,1:0)
POV3 WRITE !!,"If the Visit Control # (VCN) has been stored in RPMS,",!,"want to display it with the POV/Problem"
+1 SET %=2
+2 IF $PIECE($GET(^VEN(7.41,TIEN,5)),U,21)
SET %=1
+3 SET Z=$GET(FLD(5.21))
IF $LENGTH(Z)
SET %=$SELECT(Z=1:1,1:2)
+4 DO YN^DICN
+5 IF %Y=U
GOTO POV2
+6 IF %Y?2."^"
GOTO FIN
+7 SET FLD(5.21)=$SELECT(%=1:1,1:0)
POV4 WRITE !!,"Show only PROBLEMS (no POVs) in the POV/Problem list"
+1 SET %=2
+2 IF $PIECE($GET(^VEN(7.41,TIEN,2)),U,13)
SET %=1
+3 SET Z=$GET(FLD(2.13))
IF $LENGTH(Z)
SET %=$SELECT(Z=1:1,1:2)
+4 DO YN^DICN
+5 IF %Y=U
GOTO POV3
+6 IF %Y?2."^"
GOTO FIN
+7 SET FLD(2.13)=$SELECT(%=1:1,1:0)
POV5 WRITE !!,"Want to block the display of ICD codes entered at other facilities"
+1 SET %=2
+2 IF $PIECE($GET(^VEN(7.41,TIEN,5)),U,15)
SET %=1
+3 SET Z=$GET(FLD(5.15))
IF $LENGTH(Z)
SET %=$SELECT(Z=1:1,1:2)
+4 DO YN^DICN
+5 IF %Y=U
GOTO POV4
+6 IF %Y?2."^"
GOTO FIN
+7 SET FLD(5.15)=$SELECT(%=1:1,1:0)
POV6 KILL DIR
SET DIR("?")="You can extend the length of the provider narrative up to 80 characters"
+1 WRITE !!,DIR("?")
+2 SET DIR(0)="NO^1:80:0"
SET DIR("A")="Maximum narrative length"
SET DIR("B")="27"
+3 SET %=$PIECE($GET(^VEN(7.41,TIEN,5)),U,16)
IF %
SET DIR("B")=%
+4 IF $LENGTH($GET(FLD(5.16)))
SET DIR("B")=FLD(5.16)
+5 DO ^DIR
+6 IF Y=U
GOTO POV5
+7 IF Y?2."^"
GOTO FIN
+8 SET FLD(5.16)=Y
POVDIE ; ENTER FIELD DATA INTO RPMS AND CLEAN OUT FLD ARRAY
DO DIE(TIEN)
RX ; PRESCRIPTIONS
+1 WRITE !!,SEP," PRESCRIPTIONS ",SEP
RX1 WRITE !!,"Does this form contain a Prescription List"
+1 SET %=1
DO YN^DICN
+2 IF %Y=U
WRITE !!,SEP
GOTO POV
+3 IF %Y?2."^"
GOTO FIN
+4 IF %=2
Begin DoDot:1
+5 FOR %=.12,.14,2.11,2.4,2.6,2.7,2.8,2.9,14.01,14.02,14.03,14.04,14.05
SET FLD(%)="@"
+6 QUIT
End DoDot:1
GOTO RXDIE
RXN ; MAX RXS ; PATCHED BY GIS/OIT 10/15/05 ; PCC+ 2.5 PATCH 1
+1 WRITE !!,"Count the number of Rx mail merge fields on this form"
+2 KILL DIR
SET DIR(0)="NO^1:60:0"
SET DIR("A")="How many are there"
SET DIR("B")="15"
+3 SET %=$PIECE($GET(^VEN(7.41,TIEN,2)),U,4)
IF %
SET DIR("B")=%
+4 SET %=$GET(FLD(2.4))
IF %
SET DIR("B")=%
+5 DO ^DIR
+6 IF Y=U
GOTO RX1
+7 IF Y?2."^"
GOTO FIN
+8 SET FLD(2.4)=+Y
RX2 WRITE !!,"You can limit the time that a drug is displayed beyond it run-out date"
+1 KILL DIR
SET DIR(0)="NO^1:999:0"
SET DIR("A")="Maximum display duration (days)"
SET DIR("B")="75"
+2 SET %=$PIECE($GET(^VEN(7.41,TIEN,2)),U,6)
IF %
SET DIR("B")=%
+3 IF $LENGTH($GET(FLD(2.6)))
SET DIR("B")=FLD(2.6)
+4 DO ^DIR
+5 IF Y=U
GOTO RXN
+6 IF Y?2."^"
GOTO FIN
+7 IF Y
SET FLD(2.6)=Y
RX3 WRITE !!,"Want to display only active prescriptions"
+1 SET %=2
+2 IF $PIECE($GET(^VEN(7.41,TIEN,2)),U,8)
SET %=1
+3 SET Z=$GET(FLD(2.8))
IF $LENGTH(Z)
SET %=$SELECT(Z=1:1,1:2)
+4 DO YN^DICN
+5 IF %Y=U
GOTO RX2
+6 IF %Y?2."^"
GOTO FIN
+7 SET FLD(2.8)=$SELECT(%=1:1,1:0)
RX4 WRITE !!,"Want to hide redundant prescriptions"
+1 SET %=2
+2 IF $PIECE($GET(^VEN(7.41,TIEN,2)),U,9)
SET %=1
+3 SET Z=$GET(FLD(2.9))
IF $LENGTH(Z)
SET %=$SELECT(Z=1:1,1:2)
+4 DO YN^DICN
+5 IF %Y=U
GOTO RX3
+6 IF %Y?2."^"
GOTO FIN
+7 SET FLD(2.9)=$SELECT(%=1:1,1:0)
+8 WRITE !!,"You can now specify the max length of the RX and its components."
RX5 KILL DIR
SET DIR(0)="NO^1:80:0"
SET DIR("A")="Max length of Medication name"
SET DIR("B")="30"
+1 SET %=$PIECE($GET(^VEN(7.41,TIEN,14)),U,2)
IF %
SET DIR("B")=%
+2 IF $LENGTH($GET(FLD(14.02)))
SET DIR("B")=FLD(14.02)
+3 DO ^DIR
+4 IF Y=U
GOTO RX2
+5 IF Y?2."^"
GOTO FIN
+6 IF Y
SET FLD(14.02)=Y
RX6 KILL DIR
SET DIR(0)="NO^1:199:0"
SET DIR("A")="Max length of Sig"
SET DIR("B")="40"
+1 SET %=$PIECE($GET(^VEN(7.41,TIEN,14)),U,3)
IF %
SET DIR("B")=%
+2 IF $LENGTH($GET(FLD(14.03)))
SET DIR("B")=FLD(14.03)
+3 DO ^DIR
+4 IF Y=U
GOTO RX5
+5 IF Y?2."^"
GOTO FIN
+6 IF Y
SET FLD(14.03)=Y
+7 ; I 'RXFLAG G RX14
RX8 KILL DIR
SET DIR(0)="NO^1:999:0"
SET DIR("A")="Max length of entire prescription"
SET DIR("B")="30"
+1 SET %=$PIECE($GET(^VEN(7.41,TIEN,14)),U)
IF %
SET DIR("B")=%
+2 IF $LENGTH($GET(FLD(14.01)))
SET DIR("B")=FLD(14.01)
+3 DO ^DIR
+4 IF Y=U
GOTO RX6
+5 IF Y?2."^"
GOTO FIN
+6 IF Y
SET FLD(14.01)=Y
RX9 WRITE !!,"Want to hide the Rx reminder note"
+1 SET %=2
+2 IF $PIECE($GET(^VEN(7.41,TIEN,0)),U,12)
SET %=1
+3 SET Z=$GET(FLD(.12))
IF $LENGTH(Z)
SET %=$SELECT(Z=1:1,1:2)
+4 DO YN^DICN
+5 IF %Y=U
GOTO RX8
+6 IF %Y?2."^"
GOTO FIN
+7 SET FLD(.12)=$SELECT(%=1:1,1:0)
RX10 WRITE !!,"Want to show the prescribing provider"
+1 SET %=2
+2 IF $PIECE($GET(^VEN(7.41,TIEN,0)),U,14)
SET %=1
+3 SET Z=$GET(FLD(.14))
IF $LENGTH(Z)
SET %=$SELECT(Z=1:1,1:2)
+4 DO YN^DICN
+5 IF %Y=U
GOTO RX9
+6 IF %Y?2."^"
GOTO FIN
+7 SET FLD(.14)=$SELECT(%=1:1,1:0)
RX11 WRITE !!,"Want to display the Rx issue date"
+1 SET %=2
+2 IF $PIECE($GET(^VEN(7.41,TIEN,2)),U,11)
SET %=1
+3 SET Z=$GET(FLD(2.11))
IF $LENGTH(Z)
SET %=$SELECT(Z=1:1,1:2)
+4 DO YN^DICN
+5 IF %Y=U
GOTO RX10
+6 IF %Y?2."^"
GOTO FIN
+7 SET FLD(2.11)=$SELECT(%=1:1,1:0)
RX12 WRITE !!,"Want to show chronic meds only"
+1 SET %=2
+2 IF $PIECE($GET(^VEN(7.41,TIEN,2)),U,7)
SET %=1
+3 SET Z=$GET(FLD(2.7))
IF $LENGTH(Z)
SET %=$SELECT(Z=1:1,1:2)
+4 DO YN^DICN
+5 IF %Y=U
GOTO RX11
+6 IF %Y?2."^"
GOTO FIN
+7 SET FLD(2.7)=$SELECT(%=1:1,1:0)
RX13 WRITE !!,"Want to sort the list by 'chronic' & 'incidental' Rxs"
+1 SET %=2
+2 IF $PIECE($GET(^VEN(7.41,TIEN,14)),U,5)
SET %=1
+3 DO YN^DICN
+4 IF %Y=U
GOTO RX12
+5 IF %Y?2."^"
GOTO FIN
+6 SET FLD(14.05)=$SELECT(%=1:1,1:0)
RXDIE DO DIE(TIEN)
HMR ; EP - HEALTH MAINTENANCE REMINDERS
+1 WRITE !!,SEP," HEALTH MAINTENANCE REMINDERS ",SEP
HMR1 WRITE !!,"Does this form contain reminders"
+1 SET %=1
+2 DO YN^DICN
+3 IF %Y=U
WRITE !!,SEP
GOTO RX
+4 IF %Y?2."^"
GOTO FIN
+5 IF %=2
Begin DoDot:1
+6 ; GENERAL CLEANUP
FOR %=5.01,5.02,5.03,15.01,15.02
SET FLD(%)="@"
+7 QUIT
End DoDot:1
GOTO HMRDIE
HMR2 WRITE !!,"Want to use the new surveillance list - !RECOMMENDED!"
+1 SET %=1
+2 IF $PIECE($GET(^VEN(7.41,TIEN,5)),U)=0
SET %=2
+3 SET Z=$GET(FLD(5.01))
IF $LENGTH(Z)
SET %=$SELECT(Z=1:1,1:2)
+4 DO YN^DICN
+5 IF %Y=U
GOTO HMR1
+6 IF %Y?2."^"
GOTO FIN
+7 SET FLD(5.01)=$SELECT(%=1:1,1:0)
HMR3 WRITE !!,"When displaying reminders, hide last date & result"
+1 SET %=2
+2 IF $PIECE($GET(^VEN(7.41,TIEN,5)),U,2)=1
SET %=1
+3 SET Z=$GET(FLD(5.02))
IF $LENGTH(Z)
SET %=$SELECT(Z=1:1,1:2)
+4 DO YN^DICN
+5 IF %Y=U
GOTO HMR2
+6 IF %Y?2."^"
GOTO FIN
+7 SET FLD(5.02)=$SELECT(%=1:1,1:0)
HMR4 WRITE !!,"When displaying reminders, hide forecasts if not 'due now'"
+1 SET %=2
+2 IF $PIECE($GET(^VEN(7.41,TIEN,5)),U,3)=1
SET %=1
+3 SET Z=$GET(FLD(5.03))
IF $LENGTH(Z)
SET %=$SELECT(Z=1:1,1:2)
+4 DO YN^DICN
+5 IF %Y=U
GOTO HMR3
+6 IF %Y?2."^"
GOTO FIN
+7 SET FLD(5.03)=$SELECT(%=1:1,1:0)
HMR5 WRITE !!,"You can hide 'refusals' that are old or 'stale'."
+1 KILL DIR
SET DIR(0)="NO^1:60:0"
+2 SET DIR("A")="Maximum age of a refusal (months)"
SET DIR("B")="60"
+3 SET %=$PIECE($GET(^VEN(7.41,TIEN,15)),U)
IF %
SET DIR("B")=%
+4 IF $LENGTH($GET(FLD(15.01)))
SET DIR("B")=FLD(15.01)
+5 DO ^DIR
+6 IF Y=U
GOTO HMR4
+7 IF Y?2."^"
GOTO FIN
+8 IF Y
SET FLD(15.01)=Y
HMR6 WRITE !!,"Include patient education topics in the refusal list"
+1 SET %=2
+2 IF $PIECE($GET(^VEN(7.41,TIEN,15)),U,2)=1
SET %=1
+3 DO YN^DICN
+4 IF %Y=U
GOTO HMR5
+5 IF %Y?2."^"
GOTO FIN
+6 SET FLD(15.02)=$SELECT(%=1:1,1:0)
HMRDIE DO DIE(TIEN)
+1 ; CONTINUE IN VENPCCIX. THIS ROUTINE IS GETTING TOO LONG!!!
GOTO LAB^VENPCCIX
+2 ;
FIN ; EP - CLEANUP
DO ^XBFMK
+1 QUIT
+2 ;
DT(DA) ; EP - DELETE A TEMPLATE
+1 NEW DIC,DIK
+2 ; NOTHING TO DELETE
IF '$DATA(^VEN(7.41,+$GET(DA),0))
QUIT
+3 WRITE !!,"Are you sure you want to completely delete this template"
SET %=0
+4 DO YN^DICN
+5 IF %'=1
WRITE !,"Nothing deleted..."
DO ^XBFMK
QUIT
+6 SET DIK="^VEN(7.41,"
+7 DO ^DIK
+8 WRITE !,"Template deleted"
+9 DO ^XBFMK
+10 QUIT
+11 ;
LKUP() ; EP - LOOK UP A PCC+ TEMPLATE
+1 NEW DIC,X,Y,CIEN
+2 SET DIC="^VEN(7.41,"
+3 SET DIC(0)="AEQM"
+4 WRITE "PCC+ Template: "
+5 DO ^DIC
+6 IF Y=-1
SET TIEN=""
+7 IF '$TEST
SET TIEN=+Y
+8 DO ^XBFMK
+9 QUIT TIEN
+10 ;
DIE(DA) ; EP - UPDATE FILEMAN FIELDS
+1 NEW DR,DIE
+2 SET DIE="^VEN(7.41,"
+3 SET DR=""
SET FLD=0
+4 FOR
SET FLD=$ORDER(FLD(FLD))
IF 'FLD
QUIT
Begin DoDot:1
+5 IF $LENGTH(DR)
SET DR=DR_";"
+6 SET DR=DR_FLD_"////^S X=FLD("_FLD_")"
+7 QUIT
End DoDot:1
+8 LOCK +^VEN(7.41,DA):0
IF $TEST
DO ^DIE
LOCK -^VEN(7.41,DA)
+9 KILL FLD
+10 QUIT
+11 ;
