APCDALV ; IHS/CMI/LAB - VISIT CREATION ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;IHS/CMI/LAB - patch 3 added kill of APCDA11
;
;
;visits - 08/01/94
EN ;PEP - Called to create PCC Visits
NEW D0,DA,DIC,DIE,DR
D INIT
I $D(APCDAFLG) D EOJ Q
LOCK +^TMP("APCDALV",APCDPAT):60
I $D(APCDADD) D GENVISIT,EOJ Q ; forced add
I $D(APCDAUTO) D AUTO,EOJ Q ; non-interactive mode
D INTERACT,EOJ ; interactive mode
Q
;
;--------------------------------------------------------------
;
INTERACT ; INTERACTIVE MODE
K APCDALV
S (APCDAVD,APCDAVDC)=9999999-$P(APCDDATE,"."),APCDAVD=(APCDAVD-1)_".999999"
S APCDAC=3
F APCDAL=0:0 S APCDAVD=$O(^AUPNVSIT("AA",APCDPAT,APCDAVD)) Q:APCDAVD="" Q:$P(APCDAVD,".")'=APCDAVDC F APCDAI=0:0 S APCDAI=$O(^AUPNVSIT("AA",APCDPAT,APCDAVD,APCDAI)) Q:APCDAI="" D GATHER
I '$D(APCDALV) D GENVISIT Q ; no visits gathered
I $D(^XUSEC("APCDZVMRG",DUZ)),$D(APCDALV(5)) D
.K APCDALVX S %=0 F S %=$O(APCDALV(%)) Q:%'=+% S APCDALVX(%)=APCDALV(%)
.K APCDALV
.S %=0 F S %=$O(APCDALVX(%)) Q:%'=+% S APCDALV(%+1)=APCDALVX(%)
.S APCDAC=APCDAC+1
.K APCDALVX,%
.Q
D SELECT ; select or generate visit
I APCDAO=4,'$D(APCDALV(4)) G INTERACT
Q
;
GATHER ; GATHER VISITS FOR USER TO SELECT
S APCDAX=^AUPNVSIT(APCDAI,0)
Q:$P(APCDAX,U,11)
;Q:$P(APCDAX,U,3)'=APCDTYPE
Q:$P(APCDAX,U,6)'=APCDLOC
Q:$P(APCDAX,U,7)'=APCDCAT
I $D(APCDCLN),$P(APCDAX,U,8),APCDCLN'=$P(APCDAX,U,8) Q
S APCDAC=APCDAC+1,APCDALV(APCDAC)=APCDAI
Q
;
SELECT ; ALLOW USER TO SELECT, EXIT, OR ADD
I '$D(APCDADF),APCDAC=4 S APCDADF=APCDAC
S APCDAO=""
D OPTION ; get option from user
I APCDAO=2 S APCDAFLG=1 Q ; exit with no selection
I APCDAO=1 D GENVISIT Q ; user said generate new visit
I APCDAO=4,'$D(APCDALV(4)) D MRG^APCDALV1 G INTERACT
S Y=$P(^AUPNVSIT(APCDVSIT,0),U,5) D ^AUPNPAT K Y
Q
;
OPTION ; LET USER SELECT OPTION
D OPTION^APCDALV1
Q
;
;--------------------------------------------------------------
;
AUTO ; NON-INTERACTIVE MODE
S APCDAVDC=9999999-$P(APCDDATE,".")_"."_$P(APCDDATE,".",2)
F APCDAI=0:0 S APCDAI=$O(^AUPNVSIT("AA",APCDPAT,APCDAVDC,APCDAI)) Q:APCDAI="" D CHECK Q:APCDVSIT
Q:APCDVSIT
D GENVISIT
Q
;
CHECK ; CHECK VISIT AUTO MODE
S APCDAX=^AUPNVSIT(APCDAI,0)
Q:$P(APCDAX,U,11)
I $D(APCDCLN),$P(APCDAX,U,8)'=APCDCLN Q ;CHANGED THIS LINE ON 4/4/96 - DOES THIS FIX IT?
I '$D(APCDCLN),$P(APCDAX,U,8)]"" Q ;if not passing clinic and visit has clinic do not select this visit
Q:$P(APCDAX,U,3)'=APCDTYPE
Q:$P(APCDAX,U,6)'=APCDLOC
Q:$P(APCDAX,U,7)'=APCDCAT
S APCDVSIT=APCDAI
Q
;
;--------------------------------------------------------------
;
GENVISIT ; GENERATE NEW VISIT
S Y=APCDPAT D ^AUPNPAT K Y
S APCDSEX=AUPNSEX,APCDDOB=AUPNDOB,APCDDOD=AUPNDOD
S X=APCDDATE,%DT="TRXN" D ^%DT S X=Y I X=-1 S APCDAFLG=2,APCDAFLG("ERR")=".01^"_APCDDATE_"^DATE INVALID FOR PATIENT,CANNOT CREATE VISIT .01 VALUE" Q
D VSIT01^AUPNVSIT
I '$D(X) S APCDAFLG=2,APCDAFLG("ERR")=".01^"_APCDDATE_"^DATE INVALID FOR PATIENT,CANNOT CREATE VISIT .01 VALUE" Q
K APCDLOOK S DIC="^AUPNVSIT(",DIC(0)="L"_$S($D(ZTQUEUED)!($D(ZTSK)):"",1:"E"),DLAYGO=9000010,DIC("DR")="[APCD VISIT (ADD)]" K DD,DO D FILE^DICN K DIC,DLAYGO
I Y<0 S APCDAFLG=2,APCDAFLG("ERR")=".01^"_APCDDATE_"^FILE^DICN FAILED TO CREATE VISIT" Q
S APCDVSIT=+Y
;IHS/ITSC/LJF 8/1/2003
I $T(GETVID^VSITVID)]"",$P($G(^DIC(150.9,1,4)),U,2)]"" S VID=$$GETVID^VSITVID S DIE=9000010,DA=APCDVSIT,DR="15001///"_VID D ^DIE K VID,DIE,DR,DA
S APCDVSIT("NEW")=1
Q
;
;--------------------------------------------------------------
;
INIT ; INITIALIZATION/EDIT INPUT VARIABLES
D INIT^APCDALV1
Q
;
EOJ ; CLEAN UP
LOCK -^TMP("APCDALV",APCDPAT)
; The line below must 'hard set' the clinic code because
; ^DIE would have to be called recursively. An exception to the
; standard has been granted by DSM/OIRM.
I APCDVSIT,$D(APCDCLN),$P(^AUPNVSIT(APCDVSIT,0),U,8)="" S $P(^AUPNVSIT(APCDVSIT,0),U,8)=APCDCLN ; ***** BAD, VERY BAD, FORGIVE US PLEASE *****
I APCDVSIT,$P($G(^AUPNVSIT(APCDVSIT,11)),U,4)="" S $P(^AUPNVSIT(APCDVSIT,11),U,4)=$$UID^AUPNVSIT(APCDVSIT) ;stuff UID if blank
K X,Y
K DIRUT,DTOUT,DUOUT
K APCDADD,APCDADF,APCDAUTO
K APCDAC,APCDAI,APCDAL,APCDALV,APCDAO,APCDAVD,APCDAVDC,APCDAX,APCDA11
I $D(APCDALVR)\10 S APCDALVR("APCDPAT")=APCDPAT,APCDALVR("APCDVSIT")=APCDVSIT S:$D(APCDVSIT("NEW")) APCDALVR("APCDVSIT","NEW")=APCDVSIT("NEW") S:$D(APCDAFLG) APCDALVR("APCDAFLG")=APCDAFLG D:'$D(APCDNOK) EN1^APCDEKL
Q
APCDALV ; IHS/CMI/LAB - VISIT CREATION ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;IHS/CMI/LAB - patch 3 added kill of APCDA11
+3 ;
+4 ;
+5 ;visits - 08/01/94
EN ;PEP - Called to create PCC Visits
+1 NEW D0,DA,DIC,DIE,DR
+2 DO INIT
+3 IF $DATA(APCDAFLG)
DO EOJ
QUIT
+4 LOCK +^TMP("APCDALV",APCDPAT):60
+5 ; forced add
IF $DATA(APCDADD)
DO GENVISIT
DO EOJ
QUIT
+6 ; non-interactive mode
IF $DATA(APCDAUTO)
DO AUTO
DO EOJ
QUIT
+7 ; interactive mode
DO INTERACT
DO EOJ
+8 QUIT
+9 ;
+10 ;--------------------------------------------------------------
+11 ;
INTERACT ; INTERACTIVE MODE
+1 KILL APCDALV
+2 SET (APCDAVD,APCDAVDC)=9999999-$PIECE(APCDDATE,".")
SET APCDAVD=(APCDAVD-1)_".999999"
+3 SET APCDAC=3
+4 FOR APCDAL=0:0
SET APCDAVD=$ORDER(^AUPNVSIT("AA",APCDPAT,APCDAVD))
IF APCDAVD=""
QUIT
IF $PIECE(APCDAVD,".")'=APCDAVDC
QUIT
FOR APCDAI=0:0
SET APCDAI=$ORDER(^AUPNVSIT("AA",APCDPAT,APCDAVD,APCDAI))
IF APCDAI=""
QUIT
DO GATHER
+5 ; no visits gathered
IF '$DATA(APCDALV)
DO GENVISIT
QUIT
+6 IF $DATA(^XUSEC("APCDZVMRG",DUZ))
IF $DATA(APCDALV(5))
Begin DoDot:1
+7 KILL APCDALVX
SET %=0
FOR
SET %=$ORDER(APCDALV(%))
IF %'=+%
QUIT
SET APCDALVX(%)=APCDALV(%)
+8 KILL APCDALV
+9 SET %=0
FOR
SET %=$ORDER(APCDALVX(%))
IF %'=+%
QUIT
SET APCDALV(%+1)=APCDALVX(%)
+10 SET APCDAC=APCDAC+1
+11 KILL APCDALVX,%
+12 QUIT
End DoDot:1
+13 ; select or generate visit
DO SELECT
+14 IF APCDAO=4
IF '$DATA(APCDALV(4))
GOTO INTERACT
+15 QUIT
+16 ;
GATHER ; GATHER VISITS FOR USER TO SELECT
+1 SET APCDAX=^AUPNVSIT(APCDAI,0)
+2 IF $PIECE(APCDAX,U,11)
QUIT
+3 ;Q:$P(APCDAX,U,3)'=APCDTYPE
+4 IF $PIECE(APCDAX,U,6)'=APCDLOC
QUIT
+5 IF $PIECE(APCDAX,U,7)'=APCDCAT
QUIT
+6 IF $DATA(APCDCLN)
IF $PIECE(APCDAX,U,8)
IF APCDCLN'=$PIECE(APCDAX,U,8)
QUIT
+7 SET APCDAC=APCDAC+1
SET APCDALV(APCDAC)=APCDAI
+8 QUIT
+9 ;
SELECT ; ALLOW USER TO SELECT, EXIT, OR ADD
+1 IF '$DATA(APCDADF)
IF APCDAC=4
SET APCDADF=APCDAC
+2 SET APCDAO=""
+3 ; get option from user
DO OPTION
+4 ; exit with no selection
IF APCDAO=2
SET APCDAFLG=1
QUIT
+5 ; user said generate new visit
IF APCDAO=1
DO GENVISIT
QUIT
+6 IF APCDAO=4
IF '$DATA(APCDALV(4))
DO MRG^APCDALV1
GOTO INTERACT
+7 SET Y=$PIECE(^AUPNVSIT(APCDVSIT,0),U,5)
DO ^AUPNPAT
KILL Y
+8 QUIT
+9 ;
OPTION ; LET USER SELECT OPTION
+1 DO OPTION^APCDALV1
+2 QUIT
+3 ;
+4 ;--------------------------------------------------------------
+5 ;
AUTO ; NON-INTERACTIVE MODE
+1 SET APCDAVDC=9999999-$PIECE(APCDDATE,".")_"."_$PIECE(APCDDATE,".",2)
+2 FOR APCDAI=0:0
SET APCDAI=$ORDER(^AUPNVSIT("AA",APCDPAT,APCDAVDC,APCDAI))
IF APCDAI=""
QUIT
DO CHECK
IF APCDVSIT
QUIT
+3 IF APCDVSIT
QUIT
+4 DO GENVISIT
+5 QUIT
+6 ;
CHECK ; CHECK VISIT AUTO MODE
+1 SET APCDAX=^AUPNVSIT(APCDAI,0)
+2 IF $PIECE(APCDAX,U,11)
QUIT
+3 ;CHANGED THIS LINE ON 4/4/96 - DOES THIS FIX IT?
IF $DATA(APCDCLN)
IF $PIECE(APCDAX,U,8)'=APCDCLN
QUIT
+4 ;if not passing clinic and visit has clinic do not select this visit
IF '$DATA(APCDCLN)
IF $PIECE(APCDAX,U,8)]""
QUIT
+5 IF $PIECE(APCDAX,U,3)'=APCDTYPE
QUIT
+6 IF $PIECE(APCDAX,U,6)'=APCDLOC
QUIT
+7 IF $PIECE(APCDAX,U,7)'=APCDCAT
QUIT
+8 SET APCDVSIT=APCDAI
+9 QUIT
+10 ;
+11 ;--------------------------------------------------------------
+12 ;
GENVISIT ; GENERATE NEW VISIT
+1 SET Y=APCDPAT
DO ^AUPNPAT
KILL Y
+2 SET APCDSEX=AUPNSEX
SET APCDDOB=AUPNDOB
SET APCDDOD=AUPNDOD
+3 SET X=APCDDATE
SET %DT="TRXN"
DO ^%DT
SET X=Y
IF X=-1
SET APCDAFLG=2
SET APCDAFLG("ERR")=".01^"_APCDDATE_"^DATE INVALID FOR PATIENT,CANNOT CREATE VISIT .01 VALUE"
QUIT
+4 DO VSIT01^AUPNVSIT
+5 IF '$DATA(X)
SET APCDAFLG=2
SET APCDAFLG("ERR")=".01^"_APCDDATE_"^DATE INVALID FOR PATIENT,CANNOT CREATE VISIT .01 VALUE"
QUIT
+6 KILL APCDLOOK
SET DIC="^AUPNVSIT("
SET DIC(0)="L"_$SELECT($DATA(ZTQUEUED)!($DATA(ZTSK)):"",1:"E")
SET DLAYGO=9000010
SET DIC("DR")="[APCD VISIT (ADD)]"
KILL DD,DO
DO FILE^DICN
KILL DIC,DLAYGO
+7 IF Y<0
SET APCDAFLG=2
SET APCDAFLG("ERR")=".01^"_APCDDATE_"^FILE^DICN FAILED TO CREATE VISIT"
QUIT
+8 SET APCDVSIT=+Y
+9 ;IHS/ITSC/LJF 8/1/2003
+10 IF $TEXT(GETVID^VSITVID)]""
IF $PIECE($GET(^DIC(150.9,1,4)),U,2)]""
SET VID=$$GETVID^VSITVID
SET DIE=9000010
SET DA=APCDVSIT
SET DR="15001///"_VID
DO ^DIE
KILL VID,DIE,DR,DA
+11 SET APCDVSIT("NEW")=1
+12 QUIT
+13 ;
+14 ;--------------------------------------------------------------
+15 ;
INIT ; INITIALIZATION/EDIT INPUT VARIABLES
+1 DO INIT^APCDALV1
+2 QUIT
+3 ;
EOJ ; CLEAN UP
+1 LOCK -^TMP("APCDALV",APCDPAT)
+2 ; The line below must 'hard set' the clinic code because
+3 ; ^DIE would have to be called recursively. An exception to the
+4 ; standard has been granted by DSM/OIRM.
+5 ; ***** BAD, VERY BAD, FORGIVE US PLEASE *****
IF APCDVSIT
IF $DATA(APCDCLN)
IF $PIECE(^AUPNVSIT(APCDVSIT,0),U,8)=""
SET $PIECE(^AUPNVSIT(APCDVSIT,0),U,8)=APCDCLN
+6 ;stuff UID if blank
IF APCDVSIT
IF $PIECE($GET(^AUPNVSIT(APCDVSIT,11)),U,4)=""
SET $PIECE(^AUPNVSIT(APCDVSIT,11),U,4)=$$UID^AUPNVSIT(APCDVSIT)
+7 KILL X,Y
+8 KILL DIRUT,DTOUT,DUOUT
+9 KILL APCDADD,APCDADF,APCDAUTO
+10 KILL APCDAC,APCDAI,APCDAL,APCDALV,APCDAO,APCDAVD,APCDAVDC,APCDAX,APCDA11
+11 IF $DATA(APCDALVR)\10
SET APCDALVR("APCDPAT")=APCDPAT
SET APCDALVR("APCDVSIT")=APCDVSIT
IF $DATA(APCDVSIT("NEW"))
SET APCDALVR("APCDVSIT","NEW")=APCDVSIT("NEW")
IF $DATA(APCDAFLG)
SET APCDALVR("APCDAFLG")=APCDAFLG
IF '$DATA(APCDNOK)
DO EN1^APCDEKL
+12 QUIT
