APCDCVDT.m

APCDCVDT ; IHS/CMI/LAB - CHANGE VISIT DATE ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 ;

 ; ***** WARNING ***** This routine executes the cross-references

 ; on the .03 field (except the "AD") in order to reset the "AA"

 ; cross-reference.  Very dangerous assumptions here.  For one,

 ; if the date of the VISIT was used on any other field it would

 ; not be reset.

 ;

 ; Array APCDCVDT must be passed as follows:

 ;

 ;  APCDCVDT("VISIT DFN")=DFN of VISIT entry being changed.

 ;  APCDCVDT("VISIT DATE/TIME")=date and time to be changed to in

 ;                              internal FileMan form.

 ;  APCDCVDT("TALK")=any value including NULL

 ;

 ; If APCDCVDT("TALK") exists a dot (.) will be printed for

 ; each V FILE entry processed during both passes.

 ;

 ; Upon exit APCDCVDT("ERROR FLAG") will exist if an error was

 ; detected.

 ;

 ; It is the callers responsibility to KILL APCDCVDT.

 ;

START ;PEP - CALLED TO DELETE A PCC VISIT

 D CHK

 Q:$D(APCDCVDT("ERROR FLAG"))

 D PROCESS

 D MOD

 D EOJ

 Q

 ;

MOD ;

 S AUPNVSIT=APCDCVDT("VISIT DFN") D MOD^AUPNVSIT

 Q

CHK ; CHECK PASSED ARRAY

 K APCDCVDT("ERROR FLAG")

 I $D(APCDCVDT("VISIT DFN"))#2,APCDCVDT("VISIT DFN"),$D(APCDCVDT("VISIT DATE/TIME"))#2,APCDCVDT("VISIT DATE/TIME"),APCDCVDT("VISIT DATE/TIME")#1 Q

 S APCDCVDT("ERROR FLAG")=1

 Q

 ;

PROCESS ;

 I '$D(^AUPNVSIT(APCDCVDT("VISIT DFN"),0)) S APCDCVDT("ERROR FLAG")=2 Q

 S AUPNVSIT=APCDCVDT("VISIT DFN")

 S APCDCVOD=+^AUPNVSIT(AUPNVSIT,0),APCDCVOT=APCDCVOD#1,APCDCVOD=APCDCVOD\1

 S APCDCVND=APCDCVDT("VISIT DATE/TIME")\1,APCDCVNT=APCDCVDT("VISIT DATE/TIME")#1

 I APCDCVOD=APCDCVND,APCDCVOT=APCDCVNT Q

 I '$D(AUPNPAT),$P(^AUPNVSIT(AUPNVSIT,0),U,5) S Y=$P(^(0),U,5) D ^AUPNPAT

 I APCDCVOD=APCDCVND D TIME Q

 D DATE

 Q

 ;

TIME ; CHANGE TIME ONLY

 D CHGVISIT

 Q

 ;

DATE ; CHANGE DATE/TIME

 S APCDCVDZ=2 D VFILES

 D CHGVISIT

 S APCDCVDZ=1 D VFILES

 Q

 ;

CHGVISIT ; CHANGE VISIT ENTRY

 S DA=AUPNVSIT,DIE="^AUPNVSIT(",DR=".01///"_APCDCVND_APCDCVNT D ^DIE K DA,DIE,DR

 Q

 ;

VFILES ; CHANGE V FILES

 S APCDCVDF=9000010 F APCDCVDL=0:0 S APCDCVDF=$O(^DIC(APCDCVDF)) Q:APCDCVDF>9000010.99!(APCDCVDF'=+APCDCVDF)  D VFILE

 K APCDCVDF,APCDCVDG,APCDCVDL,APCDCVDE,APCDCVDX

 Q

 ;

VFILE ; CHANGE ONE V FILE

 S APCDCVDG=^DIC(APCDCVDF,0,"GL")

 Q:'$D(@(APCDCVDG_"""AD"","_AUPNVSIT_")"))

 S APCDCVDE="" F APCDCVDL=0:0 S APCDCVDE=$O(@(APCDCVDG_"""AD"","_AUPNVSIT_",APCDCVDE)")) Q:APCDCVDE=""  D VFILEE

 Q

VFILEE ; CHANGE ONE V FILE ENTRY

 ;

 ; ***** WARNING ****** Using ^DIK here will not work!

 ;

 S APCDCVDX=0 F APCDCVDL=0:0 S APCDCVDX=$O(^DD(APCDCVDF,.03,1,APCDCVDX)) Q:APCDCVDX'=+APCDCVDX  I ^DD(APCDCVDF,.03,1,APCDCVDX,APCDCVDZ)'["""AD""" S DA=APCDCVDE,X=AUPNVSIT X ^DD(APCDCVDF,.03,1,APCDCVDX,APCDCVDZ)

 W:$D(APCDCVDT("TALK")) "."

 Q

 ;

EOJ ; EOJ CLEANUP

 K %,%DT,C,D,D0,DA,DIC,DICR,DIE,DIG,DIH,DIU,DIV,DIW,DQ,DR,I,X,Y

 K APCDCVDE,APCDCVDF,APCDCVDG,APCDCVDL,APCDCVDX,APCDCVDZ,APCDCVND,APCDCVNT,APCDCVOD,APCDCVOT

 Q

APCDCVDT  ; IHS/CMI/LAB - CHANGE VISIT DATE ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2       ;

 +3       ; ***** WARNING ***** This routine executes the cross-references

 +4       ; on the .03 field (except the "AD") in order to reset the "AA"

 +5       ; cross-reference.  Very dangerous assumptions here.  For one,

 +6       ; if the date of the VISIT was used on any other field it would

 +7       ; not be reset.

 +8       ;

 +9       ; Array APCDCVDT must be passed as follows:

 +10      ;

 +11      ;  APCDCVDT("VISIT DFN")=DFN of VISIT entry being changed.

 +12      ;  APCDCVDT("VISIT DATE/TIME")=date and time to be changed to in

 +13      ;                              internal FileMan form.

 +14      ;  APCDCVDT("TALK")=any value including NULL

 +15      ;

 +16      ; If APCDCVDT("TALK") exists a dot (.) will be printed for

 +17      ; each V FILE entry processed during both passes.

 +18      ;

 +19      ; Upon exit APCDCVDT("ERROR FLAG") will exist if an error was

 +20      ; detected.

 +21      ;

 +22      ; It is the callers responsibility to KILL APCDCVDT.

 +23      ;

START     ;PEP - CALLED TO DELETE A PCC VISIT

 +1        DO CHK

 +2        IF $DATA(APCDCVDT("ERROR FLAG"))

               QUIT 

 +3        DO PROCESS

 +4        DO MOD

 +5        DO EOJ

 +6        QUIT 

 +7       ;

MOD       ;

 +1        SET AUPNVSIT=APCDCVDT("VISIT DFN")

           DO MOD^AUPNVSIT

 +2        QUIT 

CHK       ; CHECK PASSED ARRAY

 +1        KILL APCDCVDT("ERROR FLAG")

 +2        IF $DATA(APCDCVDT("VISIT DFN"))#2

               IF APCDCVDT("VISIT DFN")

                   IF $DATA(APCDCVDT("VISIT DATE/TIME"))#2

                       IF APCDCVDT("VISIT DATE/TIME")

                           IF APCDCVDT("VISIT DATE/TIME")#1

                               QUIT 

 +3        SET APCDCVDT("ERROR FLAG")=1

 +4        QUIT 

 +5       ;

PROCESS   ;

 +1        IF '$DATA(^AUPNVSIT(APCDCVDT("VISIT DFN"),0))

               SET APCDCVDT("ERROR FLAG")=2

               QUIT 

 +2        SET AUPNVSIT=APCDCVDT("VISIT DFN")

 +3        SET APCDCVOD=+^AUPNVSIT(AUPNVSIT,0)

           SET APCDCVOT=APCDCVOD#1

           SET APCDCVOD=APCDCVOD\1

 +4        SET APCDCVND=APCDCVDT("VISIT DATE/TIME")\1

           SET APCDCVNT=APCDCVDT("VISIT DATE/TIME")#1

 +5        IF APCDCVOD=APCDCVND

               IF APCDCVOT=APCDCVNT

                   QUIT 

 +6        IF '$DATA(AUPNPAT)

               IF $PIECE(^AUPNVSIT(AUPNVSIT,0),U,5)

                   SET Y=$PIECE(^(0),U,5)

                   DO ^AUPNPAT

 +7        IF APCDCVOD=APCDCVND

               DO TIME

               QUIT 

 +8        DO DATE

 +9        QUIT 

 +10      ;

TIME      ; CHANGE TIME ONLY

 +1        DO CHGVISIT

 +2        QUIT 

 +3       ;

DATE      ; CHANGE DATE/TIME

 +1        SET APCDCVDZ=2

           DO VFILES

 +2        DO CHGVISIT

 +3        SET APCDCVDZ=1

           DO VFILES

 +4        QUIT 

 +5       ;

CHGVISIT  ; CHANGE VISIT ENTRY

 +1        SET DA=AUPNVSIT

           SET DIE="^AUPNVSIT("

           SET DR=".01///"_APCDCVND_APCDCVNT

           DO ^DIE

           KILL DA,DIE,DR

 +2        QUIT 

 +3       ;

VFILES    ; CHANGE V FILES

 +1        SET APCDCVDF=9000010

           FOR APCDCVDL=0:0

               SET APCDCVDF=$ORDER(^DIC(APCDCVDF))

               IF APCDCVDF>9000010.99!(APCDCVDF'=+APCDCVDF)

                   QUIT 

               DO VFILE

 +2        KILL APCDCVDF,APCDCVDG,APCDCVDL,APCDCVDE,APCDCVDX

 +3        QUIT 

 +4       ;

VFILE     ; CHANGE ONE V FILE

 +1        SET APCDCVDG=^DIC(APCDCVDF,0,"GL")

 +2        IF '$DATA(@(APCDCVDG_"""AD"","_AUPNVSIT_")"))

               QUIT 

 +3        SET APCDCVDE=""

           FOR APCDCVDL=0:0

               SET APCDCVDE=$ORDER(@(APCDCVDG_"""AD"","_AUPNVSIT_",APCDCVDE)"))

               IF APCDCVDE=""

                   QUIT 

               DO VFILEE

 +4        QUIT 

VFILEE    ; CHANGE ONE V FILE ENTRY

 +1       ;

 +2       ; ***** WARNING ****** Using ^DIK here will not work!

 +3       ;

 +4        SET APCDCVDX=0

           FOR APCDCVDL=0:0

               SET APCDCVDX=$ORDER(^DD(APCDCVDF,.03,1,APCDCVDX))

               IF APCDCVDX'=+APCDCVDX

                   QUIT 

               IF ^DD(APCDCVDF,.03,1,APCDCVDX,APCDCVDZ)'["""AD"""

                   SET DA=APCDCVDE

                   SET X=AUPNVSIT

                   XECUTE ^DD(APCDCVDF,.03,1,APCDCVDX,APCDCVDZ)

 +5        IF $DATA(APCDCVDT("TALK"))

               WRITE "."

 +6        QUIT 

 +7       ;

EOJ       ; EOJ CLEANUP

 +1        KILL %,%DT,C,D,D0,DA,DIC,DICR,DIE,DIG,DIH,DIU,DIV,DIW,DQ,DR,I,X,Y

 +2        KILL APCDCVDE,APCDCVDF,APCDCVDG,APCDCVDL,APCDCVDX,APCDCVDZ,APCDCVND,APCDCVNT,APCDCVOD,APCDCVOT

 +3        QUIT