APCDALV.m

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