APCDCVD.m

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

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

 ;

 D GETPAT

 I APCDPAT="" W !!,"No PATIENT selected!" D EOJ Q

 D GETVISIT

 I APCDVSIT="" W !!,"No VISIT selected!" D EOJ Q

 D VISIT

 W !

 S DIC="^AUPNVSIT(",DA=APCDVSIT D EN^DIQ K DIC,DIQ,DA

 D EOJ

 Q

 ;

GETPAT ; GET PATIENT

 W !

 S APCDPAT=""

 S DIC="^AUPNPAT(",DIC(0)="AEMQ" D ^DIC K DIC

 Q:Y<0

 S APCDPAT=+Y

 Q

 ;

GETVISIT ;

 S APCDLOOK="",APCDVSIT=""

 K APCDVLK

 D ^APCDVLK

 K APCDLOOK

 Q

 ;

VISIT ;

 D DSPLY

 S Y=APCDDATE X ^DD("DD")

 W !!,"The date and time of the VISIT is ",Y,!

 S %DT="ATRX",%DT("A")="Enter new date and time: " D ^%DT K %DT

 I Y<0 W !!,"Bye" Q

 W !,"The new visit date and time will be: ",$$FMTE^XLFDT(Y,1)

 S X=Y D CHKVD

 Q:'$D(X)

 S APCDX=X

 S DIR(0)="Y",DIR("A")="Is this okay",DIR("B")="Y" KILL DA D ^DIR KILL DIR

 Q:$D(DIRUT)

 Q:'Y

 W "  <WAIT>"

 S APCDCVDT("VISIT DFN")=APCDVSIT

 S APCDCVDT("VISIT DATE/TIME")=APCDX

 S APCDCVDT("TALK")=1

 D ^APCDCVDT

 I $D(Y) W !,"Updating the Date Last Modified failed!!"

 Q

 ;

CHKVD ; CHECK NEW VISIT DATE

 D VSIT01^AUPNVSIT

 Q

 ;

DSPLY ;

 W !

 S DIC="^AUPNVSIT(",DA=APCDVSIT D EN^DIQ K DIC,DIQ,DA

 W !,"Do you want to see V FILE entries" S %=2 D YN^DICN S %Y=$E(%Y)

 Q:"Nn"[%Y

 S APCDVDSP=APCDVSIT D ^APCDVDSP

 Q

 ;

EOJ ; EOJ CLEANUP

 K %X,%Y,%DT,D0,DI,DK,DL,DQ,DX,S,X,Y

 K APCDCVDT,APCDX

 D EN1^APCDEKL

 Q

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

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

 +2       ;

 +3        DO GETPAT

 +4        IF APCDPAT=""

               WRITE !!,"No PATIENT selected!"

               DO EOJ

               QUIT 

 +5        DO GETVISIT

 +6        IF APCDVSIT=""

               WRITE !!,"No VISIT selected!"

               DO EOJ

               QUIT 

 +7        DO VISIT

 +8        WRITE !

 +9        SET DIC="^AUPNVSIT("

           SET DA=APCDVSIT

           DO EN^DIQ

           KILL DIC,DIQ,DA

 +10       DO EOJ

 +11       QUIT 

 +12      ;

GETPAT    ; GET PATIENT

 +1        WRITE !

 +2        SET APCDPAT=""

 +3        SET DIC="^AUPNPAT("

           SET DIC(0)="AEMQ"

           DO ^DIC

           KILL DIC

 +4        IF Y<0

               QUIT 

 +5        SET APCDPAT=+Y

 +6        QUIT 

 +7       ;

GETVISIT  ;

 +1        SET APCDLOOK=""

           SET APCDVSIT=""

 +2        KILL APCDVLK

 +3        DO ^APCDVLK

 +4        KILL APCDLOOK

 +5        QUIT 

 +6       ;

VISIT     ;

 +1        DO DSPLY

 +2        SET Y=APCDDATE

           XECUTE ^DD("DD")

 +3        WRITE !!,"The date and time of the VISIT is ",Y,!

 +4        SET %DT="ATRX"

           SET %DT("A")="Enter new date and time: "

           DO ^%DT

           KILL %DT

 +5        IF Y<0

               WRITE !!,"Bye"

               QUIT 

 +6        WRITE !,"The new visit date and time will be: ",$$FMTE^XLFDT(Y,1)

 +7        SET X=Y

           DO CHKVD

 +8        IF '$DATA(X)

               QUIT 

 +9        SET APCDX=X

 +10       SET DIR(0)="Y"

           SET DIR("A")="Is this okay"

           SET DIR("B")="Y"

           KILL DA

           DO ^DIR

           KILL DIR

 +11       IF $DATA(DIRUT)

               QUIT 

 +12       IF 'Y

               QUIT 

 +13       WRITE "  <WAIT>"

 +14       SET APCDCVDT("VISIT DFN")=APCDVSIT

 +15       SET APCDCVDT("VISIT DATE/TIME")=APCDX

 +16       SET APCDCVDT("TALK")=1

 +17       DO ^APCDCVDT

 +18       IF $DATA(Y)

               WRITE !,"Updating the Date Last Modified failed!!"

 +19       QUIT 

 +20      ;

CHKVD     ; CHECK NEW VISIT DATE

 +1        DO VSIT01^AUPNVSIT

 +2        QUIT 

 +3       ;

DSPLY     ;

 +1        WRITE !

 +2        SET DIC="^AUPNVSIT("

           SET DA=APCDVSIT

           DO EN^DIQ

           KILL DIC,DIQ,DA

 +3        WRITE !,"Do you want to see V FILE entries"

           SET %=2

           DO YN^DICN

           SET %Y=$EXTRACT(%Y)

 +4        IF "Nn"[%Y

               QUIT 

 +5        SET APCDVDSP=APCDVSIT

           DO ^APCDVDSP

 +6        QUIT 

 +7       ;

EOJ       ; EOJ CLEANUP

 +1        KILL %X,%Y,%DT,D0,DI,DK,DL,DQ,DX,S,X,Y

 +2        KILL APCDCVDT,APCDX

 +3        DO EN1^APCDEKL

 +4        QUIT