Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VENPCCM4

VENPCCM4.m

Go to the documentation of this file. 
  1. VENPCCM4 ; IHS/OIT/GIS - MANAGE TEMPLATE SYNCHRONIZATION AND VALIDATION - ;
  1.  ;;2.6;PCC+;;NOV 12, 2007
  1.  ;
  1.  ;
  1.  ;
  1. ONE ; EP-ENTRY POINT FOR CHECKING JUST ONE TEMPLATE
  1.  N DIR,IPA,IPB,FILE,Y,X,%,TSTG,Z
  1.  W !,"Enter the file name of the template you want to validate =>"
  1. ASK S DIR(0)="FO^14:44",DIR("A")="Template file name",DIR("?")="Must be in format: X_template.doc ;e.g.,wic_template.doc" KILL DA D ^DIR KILL DIR
  1.  I Y?1."^" Q
  1.  S Z=Y S Z=$TR(Z," ","")
  1.  I Z'?1.30A1"_template.doc",Z'?1.30A1"_TEMPLATE.DOC" W !,"Must use format: {mnemonic}_template.doc; e.g. 'wic_template.doc'. Try again..." G ASK
  1.  I '$$IP Q
  1.  S FILE=Y,TSTG=$$TSTG(IPA)
  1.  S IP=IPA D VAL
  1.  Q
  1.  ; 
  1. ALL ; EP-CHECK ALL TEMPLATES
  1.  N TNO,IPA,IPB,IP,TSTG,FILE,FIN
  1.  I '$$IP Q
  1.  W !,"Checking all templates on Print Server #1......."
  1.  S TSTG=$$TSTG(IPA),IP=IPA,FIN=0
  1.  F TNO=1:1:$L(TSTG,U) S FILE=$P(TSTG,U,TNO) D  I FIN=1 Q
  1.  . I FILE["hs2_"!(FILE["HS2_") Q  ; IGNORE THE HS TEMPLATE
  1.  . W !,"Evaluating '",FILE,"'"
  1.  . D VAL
  1.  . W ! I '$$WAIT^VENPCCU S FIN=1
  1.  . Q
  1.  Q
  1.  ; 
  1. VAL ; EP-VALIDATE A TEMPLATE
  1.  N X,Y,%,IFILE,ISTG,HSTG,ESTG,CNT,PAUSE,TEX,TEX1,CEX,CFSTG,TSTG1,BAR,IEX,CNAME,MNAME,LOC,TYPE,HNAME,DESC,BY,ON,AT,VER,TNAME,HSTG,ISTG,CNT,VAL,DSTG,PCE,TOT,MAX,ORD,ERR,MN,RPT
  1.  N PROB,POV,EXAM,HMR,IMM,INJ,LAB,PTED,ROS,RAD,SUPL,TRT,RX,ALL,EDITNAME,OK
  1.  W !,"One moment please...."
  1. VAR S HSTG=$$FILE^VENPCCM2("c:\program files\ilc\ilc forms print service\templates\ef_header.txt",IP)
  1.  I HSTG'[U W !,"Unable to access this template's header file.  Request terminated!" Q
  1.  S IFILE=$P(FILE,".")_"_info.txt" S IFILE=$$LOW^XLFSTR(IFILE),FILE=$$LOW^XLFSTR(FILE)
  1.  S ISTG=$$FILE^VENPCCM2(("c:\program files\ilc\ilc forms print service\templates\"_IFILE),IP)
  1.  S IEX=(ISTG[U)
  1.  S TEX=(U_TSTG_U)[(U_FILE_U)
  1.  S TEX1=1 I IPA'=IPB S TSTG1=$$TSTG(IPB) S TEX1=(U_TSTG1_U)[(U_FILE_U)
  1. DUP S CFSTG="",TIEN=0 F  S TIEN=$O(^VEN(7.41,TIEN)) Q:'TIEN  S %=$P($G(^VEN(7.41,TIEN,0)),U,3) I %=$P(FILE,"_") S:CFSTG'="" CFSTG=CFSTG_U S CFSTG=CFSTG_TIEN_";"_$P($G(^VEN(7.41,TIEN,0)),U)
  1.  S CEX=(CFSTG'="")
  1.  I CEX,CFSTG'[U S CIEN=+CFSTG,CNAME=$P(CFSTG,";",2)
  1. MSG1 ; INITIAL MESSAGE
  1.  I 'TEX,'CEX W !,"File '",FILE,"' was not found on RPMS or Print Servers!" W:'IEX !,"File '",IFILE,"' is also missing" Q
  1.  I CEX,('TEX!('TEX1)) W !,"File '",FILE,"' was not found on one of the Print Servers",!,"Add this file now!" Q
  1.  I CEX,'TEX I '$$REM1 Q
  1.  I CEX,CFSTG[U Q:'$$REM2  G DUP
  1.  I 'IEX W !,"File '",IFILE,"' not found on Print Server #1!,",!,"Create this file using the 'template info.dot' form and try again." Q
  1.  I 'CEX,'$$ADD(1) Q
  1.  I CEX,'$$ADD(2) Q
  1.  I '$$INIT(ISTG,HSTG) W !,"Invalid template information file! Request terminated..." Q  ; GET REST OF LOCAL VARIABLES
  1.  I $G(TNAME)'="",$G(CNAME)'="" S TNAME=CNAME
  1.  ; S BAR=$$BAR(+$G(CIEN)) I BAR="" W !,"Invald or missing Bar Code Caracter.  Session terminated..." Q  ; BAR CODES NO LONGER REQUIRED
  1.  D CAP,FLD,WARN,SET
  1.  Q
  1.  ; 
  1. REM1() ; MISSING TEMPLATE
  1.  N %,X,Y,%Y
  1.  W !,"The template '",FILE,"' is missing from the print servers",!,"but it is registered in the PCC+ EF TEMPLATE file on the RPMS server"
  1.  W !,"This may cause the Print Server to lock up!"
  1.  W !,"Want to remove this template from the EF TEMPLATE file"
  1.  S %=2 D YN^DICN I %=1 D  Q 1
  1.  . S DIK="^VEN(7.41.",TIEN=0
  1.  . F  S DA=$O(^VEN(7.41,DA)) Q:'DA  S %=$P($G(^VEN(7.41,DA,0)),U,3) I %=$P(FILE,"_") W !?5,$P(^VEN(7.41,DA,0),U)," removed..." D ^DIK
  1.  . K DIK,DA
  1.  . W !,"DONE!"
  1.  . Q
  1.  I $G(%Y)?1."^" Q 0
  1.  W !,"OK, You must add this file to the print servers before proceeding"
  1.  W !,"Also, create the companion file on Print Server #1 using 'template info.dot'"
  1.  Q 0
  1.  ; 
  1. REM2() ; EP-REDUNDANT CONFIG FILE ENTRIES
  1.  W !,"The EF TEMPLATE file has multiple entries linked to '",FILE,"'"
  1.  F I=1:1:$L(CFSTG,U) S %=$P(CFSTG,U,I) W !?5,$P(%,";",2)
  1.  W !!,"Please remove one of these entries..."
  1.  S DIC="^VEN(7.41,",DIC(0)="AEQ",DIC("A")="Template: ",DIC("S")="I $P(^(0),U,3)=$P(FILE,$C(999))" D ^DIC K DIC I Y=-1 Q 0
  1.  S DIK="^VEN(7.41,",DA=+Y D ^DIK
  1.  Q 1
  1.  ; 
  1. ADD(X) ; EP-ADD A NEW FILE
  1.  I X=1 W !,"File '",FILE,"' is on the Print Server",!,"but it is not registered in the EF TEMPLATE file.  Want to register it now"
  1.  I X=2 W !,"Want to update the PCC+ cnfig file for '",FILE,"'"
  1.  S %=1 D YN^DICN I %=1 Q 1
  1.  Q 0
  1.  ; 
  1. BAR(CIEN) ; EP-CHECK BAR CODE UNIQUENESS ; DEAD CODE IN 2.2
  1.  N TIEN,BAR,%,Y,STG
  1.  S TIEN=0,BAR="",%=""
  1.  I $P($G(^VEN(7.41,CIEN,0)),U,4)="" D  Q BAR
  1.  . F  S TIEN=$O(^VEN(7.41,TIEN)) Q:'TIEN  S Y=$P($G(^VEN(7.41,TIEN,0)),U,4) S:%'="" %=%_U S %=%_Y
  1.  . F Y=65:1:90,97:1:122 I %'[$C(Y) S BAR=$C(Y) Q
  1.  . Q
  1.  S %=""
  1.  F  S TIEN=$O(^VEN(7.41,TIEN)) Q:'TIEN  I TIEN'=CIEN S Y=$P($G(^VEN(7.41,TIEN,0)),U,4) S:%'="" %=%_U S %=%_Y
  1.  S BAR=$P($G(^VEN(7.41,CIEN,0)),U,4),STG=%
  1.  I (U_STG_U)'[(U_BAR_U) Q BAR
  1.  W !,"The Bar Code '"_BAR_"' assigned to this template is not unique"
  1.  W !,"Want to change it to a unique value" S %=1 D YN^DICN I %'=1 Q ""
  1.  S BAR="" F Y=65:1:90,97:1:122 I (U_STG_U)'[(U_$C(Y)_U) S BAR=$C(Y) Q
  1.  I $L(BAR) W !,"OK, The Bar Code '",BAR,"' has been assigned to this template"
  1.  Q BAR
  1.  ; 
  1. INIT(ISTG,HSTG) ; EP-CHECK ELEMENTS
  1.  S %="MNAME^LOC^TYPE^HNAME^DESC^BY^ON^AT^VER"
  1.  F I=1:1:$L(%,U) X ("S "_$P(%,U,I)_"="""_$P(ISTG,U,I))_""""
  1.  I BY="" S BY="ITSC"
  1.  I AT="" S AT="ITSC"
  1.  I ON="" S Y=DT X ^DD("DD") S ON=Y
  1.  I VER="" S VER=1.1
  1.  I $L(MNAME),$L(LOC),$L(TYPE),$L(HNAME)
  1.  E  Q 0
  1.  S TNAME=LOC_" "_TYPE,MNAME=$$LOW^XLFSTR(MNAME),TNAME=$$UP^XLFSTR(TNAME)
  1.  S HSTG=HSTG_U,ISTG=ISTG_U,ESTG="p^d^e^i^s^l^y^r^z^t^mm^md^ms^mq^mr",CNT=0 K VAL
  1.  S DSTG="Active problems / Recent POVs^ICD Preferences^Exams^Immunizations^Injections^Lab tests^Patient education topics^Radiology exams^Supplies^Treatments^Prescriptions^Allergies^Prescriptions"
  1.  F PCE=1:1:$L(ESTG,U) S MN=$P(ESTG,U,PCE) D
  1.  . S TOT=0,ERR="",RPT="",ORD=0
  1.  . S DNAME=$P(DSTG,U,PCE)
  1.  . F I=1:1:$L(ISTG,U) S X=$P(ISTG,U,I) X "I X?1"""_MN_"""1.3N" I  D
  1.  .. S TOT=TOT+1
  1.  .. I ISTG'[(U_MN_TOT_U) D
  1.  ... I $L(ISTG,(U_X_U))>2 S:RPT'="" RPT=RPT_U S RPT=RPT_X Q
  1.  ... I ERR'="" S ERR=ERR_U S ERR=ERR_TOT
  1.  ... Q
  1.  .. I 'ORD,+$P(X,MN,2)'=TOT S ORD=1
  1.  .. Q
  1.  . F I=1:1 Q:HSTG'[(U_MN_I_U)
  1.  . S MAX=I-1
  1.  . S VAL(MN)=TOT_U_MAX_U_DNAME
  1.  . I $L(ERR) S VAL(MN,1)=ERR
  1.  . I TOT>MAX S VAL(MN,2)=TOT_U_MAX
  1.  . I ORD S VAL(MN,3)=1
  1.  . I $L(RPT) S VAL(MN,4)=RPT
  1.  . I $D(VAL(MN,4)) F %=1:1:3 K VAL(MN,%)
  1.  . Q
  1.  S PROB=+$G(VAL("p")),POV=+$G(VAL("d")),EXAM=+$G(VAL("e")),HMR=26,IMM=+$G(VAL("i")),INJ=+$G(VAL("s")),LAB=+$G(VAL("l")),PTED=+$G(VAL("y"))
  1.  S ROS=13,RAD=+$G(VAL("r")),SUPL=+$G(VAL("z")),TRT=+$G(VAL("t")),RX=+$G(VAL("mm")),ALL=+$G(VAL("a"))
  1.  Q 1
  1.  ; 
  1. CAP ; EP-CAPTIONED TEMPLATE DESCRIPTION
  1.  W !,"Template: ",MNAME,?40,"Header file: ",HNAME
  1.  W !,"Descriptive name: ",TNAME
  1.  I DESC="" S DESC="NONE"
  1.  W !,"Description: ",DESC
  1.  I BY="" S BY="UNK"
  1.  W !,"Created by: ",BY
  1.  I ON="" S ON="UNK"
  1.  W ?40,"Created on: ",ON
  1.  I AT="" S AT="UNK"
  1.  W !,"Created at: ",AT
  1.  I VER="" S VER="1.1"
  1.  W ?40,"Version: ",VER
  1.  Q
  1.  ; 
  1. FLD ; EP-TABLE OF FIELDS
  1.  N N,T,Y,X,MN
  1.  W !!,"Field",?7,"Description",?38,"# on this form",?55,"Max allowed on this form"
  1.  W !,"-----",?7,"---------------------------",?38,"---------------",?55,"------------------------"
  1.  S MN="" F  S MN=$O(VAL(MN)) Q:MN=""  D
  1.  . I "^md^ms^mq^mr^"[(U_MN_U) Q
  1.  . S X=VAL(MN) I $L(X)'>3 Q
  1.  . S N=+X,T=+$P(X,U,2),Y=$P(X,U,3)
  1.  . W !,MN,?7,Y,?38,N,?55,T
  1.  . Q
  1.  Q
  1.  ; 
  1. WARN ; EP-PRINT WARNINGS
  1.  N MN,A,B,C
  1.  S MN="",OK=0 F  Q:OK  S MN=$O(VAL(MN)) Q:MN=""  I MN'="x",MN'="d" F I=1:1:4 I $D(VAL(MN,I)) S OK=1 Q
  1.  I 'OK Q
  1.  W ! I '$$WAIT^VENPCCU Q
  1.  I %?1."^" Q
  1.  W *13,?79,*13,?20,"*****  WARNINGS  *****",!
  1.  S MN="" F  S MN=$O(VAL(MN)) Q:MN=""  I $D(VAL(MN))=11,MN'="d" W ! D
  1.  . I $D(VAL(MN,1)) S %=VAL(MN,1) W !,"Missing elements: " F I=1:1:$L(%,U) W:I>1 ", " W MN,$P(%,U,I)
  1.  . I $D(VAL(MN,2)) W !,"The number of '",MN,"' fields exceeds the maximum number allowed!"
  1.  . I $G(VAL(MN,3)) W !,"Fields of type '",MN,"' appear to be out of order!"
  1.  . I $D(VAL(MN,4)) S %=VAL(MN,4) W !,"Repeated elements: " F I=1:1:$L(%,U) W:I>1 ", " W $P(%,U,I)
  1.  . Q
  1.  Q
  1.  ; 
  1. SET ; EP-UPDATE THE CONFIG FILE
  1.  N DIC,DIE,DR,DA,X,Y,%
  1.  W !!,"Do you want to update your EF TEMPLATE file now"
  1.  S %=$S($G(OK):2,1:1) D YN^DICN I %'=1 W !,"Configuration file not updated" Q
  1.  D DIE
  1.  W !,"The VEN EHP EF TEMPLATE file has been updated!"
  1.  Q
  1.  ; 
  1. DIE S X=$G(CNAME,TNAME),DIC="^VEN(7.41,",DIC(0)="L",DLAYGO=19707.41 D ^DIC S:Y>0 DA=+Y
  1.  I Y=-1 W !,"Unable to update EF TEMPLATE file!  Request terminated..." Q
  1.  S DIE="^VEN(7.41,",BAR=$G(BAR)
  1.  S DR=".02///"_$P(HNAME,$C(95))_";.03///^S X=$P(MNAME,$C(95));.04///^S X=BAR;.05///^S X=VER;.06///^S X=ON;.07///^S X=AT;.08///^S X=BY;1.1///^S X=PROB;1.2///^S X=POV;1.3///^S X=TRT;1.4///^S X=HMR;1.5///^S X=IMM;1.6///^S X=INJ;1.7///^S X=LAB"
  1.  L +^VEN(7.41,DA):0 I $T D ^DIE L -^VEN(7.41,DA)
  1.  S DR="1.8///^S X=PTED;1.9///^S X=ROS;2.1///^S X=RAD;2.2///^S X=SUPL;2.3///^S X=TRT;2.4///^S X=RX;2.5///^S X=ALL"
  1.  L +^VEN(7.41,DA):0 I $T D ^DIE L -^VEN(7.41,DA)
  1.  I $D(EDITNAME) S DR=".01///^S X=EDITNAME" L +^VEN(7.41,DA):0 I $T D ^DIE L -^VEN(7.41,DA)
  1.  S ^VEN(7.41,DA,3,0)="^^1^1^"_DT
  1.  S ^VEN(7.41,DA,3,1,0)=DESC
  1.  D LINK(DA)
  1.  D ^XBFMK
  1.  Q
  1.  ; 
  1. IP() ; EP-GET IP ADDRESSES FOR PRINT SERVERS
  1.  I $L($G(IP1)),$L($G(SOCKET)) S IPA=IP1,SOCK=SOCKET,IPB=$G(IP2,IP1) Q 1
  1.  S IPA=$P($G(^VEN(7.5,+$$CFG^VENPCCU,11)),U,1)
  1.  S IPB=$P($G(^VEN(7.5,+$$CFG^VENPCCU,11)),U,2)
  1.  S SOCK=$P($G(^VEN(7.5,+$$CFG^VENPCCU,11)),U,3)
  1.  I IPA'="",IPB="" S IPB=IPA
  1.  I IPB'="",IPA="" S IPA=IPB
  1.  I IPA="",IPB="" W !,"Unable to find the IP address for any Print Server. Request terminated..." Q 0
  1.  Q 1
  1.  ; 
  1. TSTG(IP) ; EP-RETURN THE TEMPLATE STRING IN THE PROPER FORMAT
  1.  N TSTG
  1.  S TSTG=$$TEMPLATE^VENPCCM2(IP)
  1.  I $L(TSTG) S TSTG=$$LOW^XLFSTR(TSTG)
  1.  Q TSTG
  1.  ; 
  1.  N X,Y,DIC,DIE,DR,DA
  1.  I '$O(^VEN(7.92,0)) Q
  1.  I '$D(^VEN(7.93,"AS")) Q
  1.  W !,"Want to link this template to an order set"
  1.  S %=1 D YN^DICN I %'=1 Q
  1.  S DIC="^VEN(7.92,",DIC(0)="AEQ",DIC("A")="Order set: "
  1.  D ^DIC I Y=-1 Q
  1.  S DIE="^VEN(7.41,",DA=LINK,DR=".09////"_+Y
  1.  L +^VEN(7.41):0 I $T D ^DIE L -^VEN(7.41)
  1.  W !,"The template and order set have been linked..."
  1.  Q
  1.  ;