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

VENPCCW.m

Go to the documentation of this file. 
  1. VENPCCW ; IHS/OIT/GIS - SILENT VISIT CHECK-IN CALL ;
  1.  ;;2.6;PCC+;;NOV 12, 2007
  1.  ; MOJO EXTENSIONS FOR PCC+
  1.  ;
  1.  ; 2.5 EXTENSIONS FOR MOJO AND THE NEW GUI SCHEDULER
  1.  ;
  1.  ;
  1. CHECKIND(OUT,CKINDT,DFN,PRVIEN,CLIEN,DEFEF,OUTGUIDE,NEWVISIT,OUTMODE) ; EP-debug mode
  1.  S ^GREG("CKIN")=$G(DFN)
  1.  ; D DEBUG^%Serenji("CHECKIN^VENPCCW(.OUT,CKINDT,DFN,PRVIEN,CLIEN,DEFEF,OUTGUIDE,NEWVISIT,OUTMODE)")
  1.  Q
  1.  ;
  1. CHECKIN(OUT,CKINDT,DFN,PRVIEN,CLIEN,DEFEF,OUTGUIDE,NEWVISIT,OUTMODE) ;EP - RPC (VEN CHECKIN): Check in appointment
  1.  ; MOJO ENABLED!
  1.  ; CKINDT = Checkin date/time
  1.  ; DFN = patient IEN
  1.  ; PRVIEN = Provider IEN
  1.  ; OUTGUIDE = true/false print OutGuide
  1.  ; CLIEN = VEN EHP CLINIC IEN
  1.  ; DEFEF = VEN EHP TEMPLATE IEN
  1.  ; NEWVISIT = OK TO CREATE A NEW VISIT
  1.  ; OUTMODE = CLASSICPCC, TABLET, DIGITALPEN (MOJO)
  1. INIT ; INITIALIZE VARIABLES
  1.  N X,NODE,%,%DT,Y,VIEN,VCN,DEFHS,VARS,APPT,EXT,MOJOFLAG,OGFLAG,CSTOP,LOC,ELIG,ICD9,ICD,VENDEV,JOB,TQIEN,DHS
  1.  D ^XBKVAR S X="ERROR^VENPCCW",@^%ZOSF("TRAP")
  1.  S NODE=0
  1.  S OUT=$NA(^TMP("BSDX",$J))
  1.  K @OUT
  1. HDR  ; GET ADO HEADER RECORD
  1.  S @OUT@(0)="T00020ERRORID^T00030ERRORTEXT^T16000MOJODATA"_$C(30)
  1. VDT  ; GET CHECKIN DATE AND TIME
  1.  S:CKINDT["@0000" CKINDT=$P(CKINDT,"@")
  1.  S %DT="T",X=CKINDT D ^%DT S CKINDT=Y
  1. TF ; TRANSFORM FLAGS
  1.  S OUTGUIDE=$E($$UP^XLFSTR($G(OUTGUIDE)))
  1.  S NEWVISIT=$E($$UP^XLFSTR($G(NEWVISIT)))
  1. VALID ; CHECK TO MAKE SURE ALL REQUIRED PARAMS ARE PRESENT
  1.  I CKINDT=-1 D ERR(0,"VENPCCW: Invalid checkin date/time Parameter") Q
  1.  I '+DFN D ERR(0,"VENPCCW: Invalid patient ID Parameter") Q
  1.  I '+PRVIEN D ERR(0,"VENPCCW: Invalid provider ID Parameter") Q
  1.  I '+CLIEN D ERR(0,"VENPCCW: Invalid PCC+ Clinic Parameter") Q
  1.  I '+DEFEF D ERR(0,"VENPCCW: Invalid PCC+ Template Parameter") Q
  1. SECVAR ; MAKE SECONDARY VARIABLES
  1.  S %=$G(OUTGUIDE) I %="T"!(%="t") S OGFLAG=1
  1.  S DEFHS="" S APPT="" S EXT=""
  1.  S LOC=$G(DUZ(2)) I 'LOC S LOC=$P($G(^VEN(7.95,+$G(CLIEN),2)),U,4)
  1.  I 'LOC D ERR(0,"VENPCCW: Unable to determine Location IEN") Q
  1.  S CSTOP=$P($G(^VEN(7.95,+$G(CLIEN),0)),U,4)
  1.  I 'CSTOP D ERR(0,"VENPCCW: Unable to determine Clinic Stop IEN") Q
  1. VISIT S VIEN=""
  1.  S VIEN=$$DUP^VENPCCW(DFN,CLIEN) ; CHECK FOR DUP VISIT: SAME PT & PCC+ CLINIC WITHIN 6 HRS
  1.  I 'VIEN S VIEN=$$VISIT^VENPCC3(DFN,CKINDT,LOC,CSTOP)
  1.  I 'VIEN D ERR(0,"VENPCCW: Unable to create a visit") Q
  1.  S VCN=$P($G(^AUPNVSIT(VIEN,11)),U,3)
  1.  I '$L(VCN) S VCN=$$VCN^VENPCC3(VIEN,CLIEN) S VCN=$P(VCN,U)
  1.  I '$L(VCN) D ERR(0,"VENPCCW: Unable to find VCN") Q
  1.  S VARS=$$PACK^VENPCC
  1. GETDATA ; GET DATA FROM PCCPLUS
  1.  I $G(OUTMODE)="STD"!($G(OUTMODE)="") S OUTMODE="CLASSICPCC" ; FOR BKWD COMPATIBILITY
  1.  I $G(OUTMODE)'="CLASSICPCC" D  G QUEUE ; IF THIS IS A MOJO REQUEST...
  1.  . S MOJOFLAG=1 ; TELLS PCC+ TO OUTPUT THE DATA FILE TO MOJO ARRAY
  1.  . S MOJOFLAG(1)=OUTMODE
  1.  . Q
  1. QUEUE ; UPDATE THE VEN QUEUE FILE
  1.  D QUEUE^VENPCCA(VIEN,CLIEN,$G(OGFLAG),"","",PRVIEN) ; 2.5 ADD PARAMETER FOR PROVIDER
  1. PCCPLUS ; GET DATA STRING FROM PCC+ AND MAKE MOJO ARRAY IF MOJOFLAG IS SET
  1.  D PRINT^VENPCC10(VIEN,VCN,CLIEN,PRVIEN,DEFEF,DEFHS,$G(APPT),$G(VARS),$G(EXT))
  1. FIN ; ADD END OF FILE MARKER AND QUIT
  1.  S NODE=$O(@OUT@(999999999),-1)+1
  1.  I '$G(MOJOFLAG) S @OUT@(NODE)="1^OK^"_$C(30),NODE=NODE+1 ; CLASSIC PCC+ FEEDBACK
  1.  S @OUT@(NODE)=$C(31)
  1.  K ^TMP("VEN PRNT",$J) ; CLEAN OUT CLASSIC PCC+ NODES FROM TMP GLOBAL - THEY ARE NOT NEEDED ANYMORE
  1.  Q
  1.  ;
  1. DUP(DFN,DIEN) ; EP-GIVEN A DFN AND DEPT STOP IEN RETURN VIEN IF DUPLICATE VISIT
  1.  I '$D(^DPT(+$G(DFN),0)) Q ""
  1.  I '$D(^VEN(7.95,+$G(DIEN),0)) Q ""
  1.  N QIEN,TIME,DIFF,DEPT,STOP
  1.  S QIEN=99999999999,VIEN=0
  1.  F  S QIEN=$O(^VEN(7.2,"AP",DFN,QIEN),-1) Q:'QIEN  D  I $G(STOP) Q
  1.  . S TIME=+$G(^VEN(7.2,QIEN,0)) I 'TIME Q
  1.  . S DIFF=$$FMDIFF^XLFDT($$NOW^XLFDT,TIME,2)
  1.  . I DIFF>(3600*6) S STOP=1 Q
  1.  . S DEPT=$P(^VEN(7.2,QIEN,0),U,4) I 'DEPT Q
  1.  . I DEPT'=DIEN Q
  1.  . S VIEN=$P($G(^VEN(7.2,QIEN,1)),U,2),STOP=1
  1.  . Q
  1.  Q VIEN
  1.  ; 
  1.  ;-----------------------------------------------------------------
  1.  ; 
  1. MOJODATA ; EP-MAKE MOJO ARRAY
  1.  ; IF MOJOFLAG=1, PCC+ DATA MINING PROCESS BRANCHES HERE FOR ITS OUTPUT
  1.  N CREF,DA,FLD,VAL,STG,X,ERR,RED,FIEN,FID,%,NODE,MP,TAB
  1.  S TAB=$C(68)_" TQ"_U
  1.  S TAB=TAB_"VENPCCTQ"
  1.  S CREF=$NA(^TMP("VEN PRNT",$J)),DA=0,STG=""
  1.  S RED="^chart^dob^patient^agesex^tribe^ssn^community^provider^timestamp^ellig^uid^hdr^" ; REDUNDANT ENTRY LIST
  1.  I $G(MOJOFLAG(1))="DIGITALPEN" D  I MP="" Q  ; MOJO PRINTER MUST EXIST IN DIGITAL PEN MODE
  1.  . D HS(VISIT,DEPTIEN) ; FIRST, PRINT STANDARD HEALTH SUMMARY AND OUTGUIDE (IF NECESSARY)
  1.  . S MP=$P($G(^VEN(7.95,+$G(DEPTIEN),3)),U) ; GET MOJO PRINTER
  1.  . I MP="" D  Q
  1.  .. S ERR="MOJO printer is undefined" D ERR^VENPCC1(ERR) ; UPDATE PCC+ ERROR FILE
  1.  .. S @OUT@(1)="0^MOJO printer is undefined^"_$C(30) ; UPDATE RPC STRING
  1.  .. Q
  1.  . S @CREF@(1,"group")=MP ; ADD MOJO PRINTER TO ARRAY
  1.  . Q
  1. HARDCODE ; EP-FOR DIGITAL FORMS ONLY, ADD HARD CODED FIELDS TO THE DATA STRING
  1.  S FIEN=0 F  S FIEN=$O(^VEN(7.41,+$G(DEFEF),13,FIEN)) Q:'FIEN  D
  1.  . S X=$G(^VEN(7.41,+$G(DEFEF),13,FIEN,0)) I '$L(X) Q
  1.  . S FLD=$P(X,U),VAL=$P(X,U,2)
  1.  . S @CREF@(1,FLD)=VAL ; CREATE NEW DATA VALUE OR OVERWRITE AN EXISTING DATA VALUE
  1.  . Q
  1.  ; DON'T NEED TO WORRY ABOUT OVERWRITING OR DELETING FIELDS THAT ARE NOT ON THE FORM ANYWAY!
  1. CVT ; CONVERT DATA ARRYA TO A PREFILL STRING FOR MOJO
  1.  S FLD=""
  1.  F  S FLD=$O(@CREF@(1,FLD)) Q:FLD=""  D  ; MAIN PROCESSING LOOP!!!
  1.  . S VAL=$G(@CREF@(1,FLD))
  1.  . S VAL=$TR(VAL,"{","[") ; VAL CAN'T CONTAIN A DELIMITER CHARACTER
  1.  . S VAL=$TR(VAL,"}","]") ; VAL CAN'T CONTAIN A DELIMITER CHARACTER
  1.  . S %="" I $L(STG) S %="}" ; MUST NOT USE "^" AS A DELIMITER AT THIS LEVEL ; FIX
  1.  . S STG=STG_%_FLD_"{"_VAL
  1. RED . I RED[(U_FLD_U) S STG=STG_"}"_FLD_"_2"_"{"_VAL Q  ; MAKE STD REDUNDANT IDENTIFIERS FOR SECOND PAGE OF THE FORM
  1.  . I $D(^VEN(7.41,+$G(DEFEF),12,"B",FLD)) S STG=STG_%_FLD_"_2"_"{"_VAL Q  ; MAKE CUSTOM REDUNDANT IDENTIFIERS
  1.  . Q
  1. FID ; ADD FORM INSTANCE ID AND METADATA FIELDS TO THE PREFILL STRING
  1.  S %=$H,FID=+$G(VIEN,"X999")_"."_+%_"."_$P(%,",",2)
  1.  S STG=STG_"}FormInstanceID{"_FID
  1. META ; DATA THAT MUST PASS THRU FROM THE PRE-FILL TO THE UPLOAD ; FORMAT fieldname1~val1~fieldname2~val2;...
  1.  S STG=STG_"}metadata{u100~"_$P($G(^VEN(7.41,+$G(DEFEF),11)),U) ; FORM ID
  1.  S STG=STG_";EDET~"_$$DTIME(+$G(DEFEF)) ; NEED EARLIEST DE TIME OTHER END
  1. MODE ; ALL PREVIOUS MOJO PROCESSING LEADS TO THIS MAIN DIVISION POINT: TABLET OR PEN
  1.  I $G(MOJOFLAG(1))="TABLET" S STG=STG_";CLIEN~"_$G(CLIEN) G TABLET
  1.  I $G(MOJOFLAG(1))="DIGITALPEN" G PEN
  1.  Q
  1.  ; 
  1. TABLET ; "TABLET" MODE
  1.  X TAB ; ADD NEW RECORD TO TABLET QUEUE FILE INCLUDING THE PRE-FILL DATA NODES
  1.  ; IN TABLET MODE, THE DATA NODE MUST BE HELD UNTIL THE FORM IS ACTUALLY CREATED ON THE TABLET SCREEN
  1.  ; THE DATA IS HELD (HIDDEN) IN A ROW OF THE TABLET QUEUE FILE ROW
  1.  ; WHEN THE USER SELECTS A RECORD IN THE TABLET QUEUE, THE PREFILL DATA IS FINALLY UTILIZED TO BUILD THE FORM
  1.  S @OUT@(1)="1^OK^"_$C(30) ; SEND FEEDBACK TO THE RPC ASSOCIATED WITH THE "TABLET" BUTTON
  1.  Q
  1.  ; 
  1. PEN ; "DIGITALPEN" MODE
  1.  ; UNLIKE THE TABLET MODE, PEN DATA IS NOT HELD FOR FUTURE USE BECAUSE THE FORM IS BUILT IMMEDIATLY
  1.  ; THE PRE-FILL DATA ARRAY IS PASSED BACK TO THE RPC AS SOON AS IT IS COLLECTED
  1.  S @OUT@(1)="1^OK^" ; SEND A "{}" DELIMITED DATA ARRAY BACK TO THE RPC ASSOCOATED WITH THE "DIGITAL PEN" BUTTON
  1.  F NODE=2:1 Q:'$L(STG)  S @OUT@(NODE)=$E(STG,1,240),STG=$E(STG,241,999999999)
  1.  S @OUT@(NODE)=$C(30)
  1.  Q
  1.  ; 
  1. DTIME(DEFEF) ; EP - DELAY TIME BEFORE DATA ENTRY IS ALLOWED
  1.  N T1,T2,DELAY
  1.  S DELAY=$P($G(^VEN(7.41,+$G(DEFEF),11)),U,4) I 'DELAY S DELAY=0
  1.  S T1=$$NOW^VENPCCU
  1.  S T2=$$FMADD^XLFDT(T1,,DELAY)
  1.  Q T2
  1.  ;
  1. HS(VIEN,DEPTIEN) ; EP-PRINT PCC+ HEALTH SUMMARY WITHIN MOJO (PEN MODE ONLY)
  1. HSQ Q  ; TEMP BYPASS HS PRINTOUT
  1.  N %,DEFHS,DFN
  1.  I '$D(CFIGIEN) S CFIGIEN=$$CFG^VENPCCU
  1.  I '$G(EFONLY),'$G(OGONLY),$G(DEPTIEN),$G(VIEN) ; OK TO PRINT HS & REQD VARIABLES ARE PRESENT
  1.  E  Q
  1.  S DFN=$P($G(^AUPNVSIT(VIEN,0)),U,5) I 'DFN Q
  1.  S DEFHS=+$P($G(^VEN(7.95,DEPTIEN,2)),U,6)
  1.  I 'DEFHS D  I 'DEFHS Q
  1.  . S %=+$P($G(^DPT(DFN,0)),U,3)
  1.  . I % S %=(DT-%)\10000 I %<12 S DEFHS=$O(^APCHCTL("B","PEDIATRIC",0)) I DEFHS Q  ; AGE <12 SO USE PEDS HS
  1.  . S DEFHS=$O(^APCHCTL("B","ADULT REGULAR",0))
  1.  . Q
  1.  D HS^VENPCC2A(DFN,DEFHS,VIEN,DEPTIEN)
  1.  Q
  1.  ; 
  1.  ; --------------------------------------------------
  1.  ;
  1. SCX(PRV,VISIT,VCN,CSIEN) ; EP-SCHEDULING PKG INTERFACE FROM BSDX
  1.  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
  1.  N IO,IOF,IOM,ION,IOS,IOST,IOT,IOXY,%E,POP
  1.  N OGFLAG
  1.  S OGFLAG=$G(BSDXVEN("OUTGUIDE"))
  1.  S OGFLAG=$S(OGFLAG="true":1,1:0)
  1.  S PRV=+$$PRV^VENPCCU(+$G(PRV))
  1.  S CFIGIEN=$$CFG^VENPCCU
  1.  S DEPTIEN=$G(BSDXVEN("CLINIC"))
  1.  I '+DEPTIEN Q
  1.  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)
  1.  I '$D(^VA(200,+$G(PRV),0)) Q
  1.  S DEFEF=$G(BSDXVEN("FORM"))
  1.  I '+DEFEF Q
  1.  S DEFHS="",EFONLY=1,APPT=$G(ASDDT),EXT=""
  1.  D QUEUE^VENPCCA(VISIT,DEPTIEN,"","","",PRV)
  1.  I $D(NOTASK) D EN1^VENPCCA("D",1)
  1.  S VARS=$$PACK^VENPCC,EXT=""
  1.  D EN1^VENPCCA("J",1)
  1.  I $D(VPFLAG) K HSONLY,VPFLAG
  1.  Q
  1.  ;
  1.  ; -----------------------
  1.  ; 
  1. ERR(ERRID,ERRTXT) ; EP-Error processing
  1.  S:'+$G(NODE) NODE=999999
  1.  S NODE=NODE+1
  1.  S @OUT@(NODE)=ERRID_"^"_ERRTXT_U_$C(30)
  1.  S NODE=NODE+1
  1.  S @OUT@(NODE)=$C(31)
  1.  Q
  1.  ;
  1. ERROR ; EP-MUMPS ERROR TRAP
  1.  D ^%ZTER
  1.  I '+$G(NODE) N NODE S NODE=999999
  1.  S NODE=NODE+1
  1.  D ERR(0,"VENPCCW M Error: <"_$G(%ZTERROR)_">")
  1.  Q
  1.  ;