ACDDIC.m

ACDDIC ;IHS/ADC/EDE/KML - DATA ENTER/EDIT FOR CDMIS FORMS;

 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998

 ;*****************************************************************

 ;The CDMIS program file walks across to ^ACDVIS vis a backward program

 ;pointer field in the visit file. This is the screen when selecting

 ;visits. FM only displays visits matching this pointer to the program

 ;i.e any user can only see what is in their signon facility

 ;********************************************************************

EN ;EP Input for CDMIS forms 1

 ;//[ACD VISIT DATA ADD]

 Q  ;************************

 S ACDDUZZ=DUZ(2)

 S DIC("DR")=""

 W @IOF,"Signon Program is            : ",$P(^DIC(4,DUZ(2),0),U)

 W !,"Records that may be added are: THOSE WITHIN YOUR SIGNIN PROGRAM.",!

 W !,"ADDING CDMIS VISIT RECORDS...",!!

 ;K DTOUT S DIE="^ACDF5PI(",DA=DUZ(2),DR="[ACD VISIT DATA ADD]",DIE("NO^")="BACK" D ^DIE S DUZ(2)=ACDDUZZ I $D(DTOUT) D AUTO^ACDDIK,K Q

 D CHK K ACDVISP D K Q

EN2 ;EP Edit for CDMIS forms 1

 ;//[ACD VISIT DATA EDIT]

 Q  ;************************

 S ACDDUZZ=DUZ(2)

 W @IOF,"Signon Program is   : ",$P(^DIC(4,DUZ(2),0),U)

 W !,"Editable Records are: THOSE NOT EXTRACTED."

 W !,"                      THOSE WITHIN YOUR SIGNIN PROGRAM.",!

 W !,"EDITING CDMIS VISIT RECORDS...",!!

 ;S DIE="^ACDF5PI(",DA=DUZ(2),DR="[ACD VISIT DATA EDIT]" D ^DIE S DUZ(2)=ACDDUZZ

 I DUZ(2)=0 S DUZ(2)=ACDDUZ(2)

 D CHK,^ACDDIFF D ^ACDWK K ACDVISP D K Q

 ;

EN3 ;EP Add additional Client Service

 ;//[ACD 1CSADD]

 Q  ;*************************

 W @IOF,"Signon Program is   : ",$P(^DIC(4,DUZ(2),0),U)

 W !,"Editable Records are: THOSE NOT EXTRACTED."

 W !,"                      THOSE WITHIN YOUR SIGNIN PROGRAM.",!

 W !,"ADDING CLIENT SERVICE DAYS TO EXISTING RECORDS...",!!

 ;S DIE="^ACDF5PI(",DA=DUZ(2),DIE("NO^")="BACK",DR="[ACD 1 (ACS)]" D ^DIE

 D CHK K ACDVISP D K Q

CHK ;

 Q  ;********************************

 Q:'$D(ACDVISP)

 K ACDTOUT

 I $O(^ACDIIF("C",ACDVISP,0)) D K Q

 ;

 ;If the visit was a 'TDC' ask user to duplicate with an

 ;initial or re-open visit

 I $O(^ACDTDC("C",ACDVISP,0)) D EN^ACDAUTO,K Q

 ;

 ;If the visit was a client service (new visit) then ask

 ;the user to exactly duplicate it for other patients.

 I $O(^ACDCS("C",ACDVISP,0)) D EN^ACDAUTO1,K Q

 ;

 S ACDTOUT=1 D AUTO^ACDDIK

 Q

K ;

 K DIC,DIE,DA,ACDTOUT,ACDCOMC,ACDDA,ACDDFNP,DR,ACDDR,ACDIO,ACDX,ACDDOV,ACD80,ACDRPC,ACDOK,ACDN0,ACDAGE,ACDDUZZ,ACDLINE,ACDHS,ACDAGE,ACDCAGE,ACDSEX,ACDVET,ACDTRB,ACDTRBN,ACDTRBCD,ACDTRBNM,ACDSTA,ACDSTACD,ACDSTANM

ACDDIC    ;IHS/ADC/EDE/KML - DATA ENTER/EDIT FOR CDMIS FORMS;

 +1       ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998

 +2       ;*****************************************************************

 +3       ;The CDMIS program file walks across to ^ACDVIS vis a backward program

 +4       ;pointer field in the visit file. This is the screen when selecting

 +5       ;visits. FM only displays visits matching this pointer to the program

 +6       ;i.e any user can only see what is in their signon facility

 +7       ;********************************************************************

EN        ;EP Input for CDMIS forms 1

 +1       ;//[ACD VISIT DATA ADD]

 +2       ;************************

           QUIT 

 +3        SET ACDDUZZ=DUZ(2)

 +4        SET DIC("DR")=""

 +5        WRITE @IOF,"Signon Program is            : ",$PIECE(^DIC(4,DUZ(2),0),U)

 +6        WRITE !,"Records that may be added are: THOSE WITHIN YOUR SIGNIN PROGRAM.",!

 +7        WRITE !,"ADDING CDMIS VISIT RECORDS...",!!

 +8       ;K DTOUT S DIE="^ACDF5PI(",DA=DUZ(2),DR="[ACD VISIT DATA ADD]",DIE("NO^")="BACK" D ^DIE S DUZ(2)=ACDDUZZ I $D(DTOUT) D AUTO^ACDDIK,K Q

 +9        DO CHK

           KILL ACDVISP

           DO K

           QUIT 

EN2       ;EP Edit for CDMIS forms 1

 +1       ;//[ACD VISIT DATA EDIT]

 +2       ;************************

           QUIT 

 +3        SET ACDDUZZ=DUZ(2)

 +4        WRITE @IOF,"Signon Program is   : ",$PIECE(^DIC(4,DUZ(2),0),U)

 +5        WRITE !,"Editable Records are: THOSE NOT EXTRACTED."

 +6        WRITE !,"                      THOSE WITHIN YOUR SIGNIN PROGRAM.",!

 +7        WRITE !,"EDITING CDMIS VISIT RECORDS...",!!

 +8       ;S DIE="^ACDF5PI(",DA=DUZ(2),DR="[ACD VISIT DATA EDIT]" D ^DIE S DUZ(2)=ACDDUZZ

 +9        IF DUZ(2)=0

               SET DUZ(2)=ACDDUZ(2)

 +10       DO CHK

           DO ^ACDDIFF

           DO ^ACDWK

           KILL ACDVISP

           DO K

           QUIT 

 +11      ;

EN3       ;EP Add additional Client Service

 +1       ;//[ACD 1CSADD]

 +2       ;*************************

           QUIT 

 +3        WRITE @IOF,"Signon Program is   : ",$PIECE(^DIC(4,DUZ(2),0),U)

 +4        WRITE !,"Editable Records are: THOSE NOT EXTRACTED."

 +5        WRITE !,"                      THOSE WITHIN YOUR SIGNIN PROGRAM.",!

 +6        WRITE !,"ADDING CLIENT SERVICE DAYS TO EXISTING RECORDS...",!!

 +7       ;S DIE="^ACDF5PI(",DA=DUZ(2),DIE("NO^")="BACK",DR="[ACD 1 (ACS)]" D ^DIE

 +8        DO CHK

           KILL ACDVISP

           DO K

           QUIT 

CHK       ;

 +1       ;********************************

           QUIT 

 +2        IF '$DATA(ACDVISP)

               QUIT 

 +3        KILL ACDTOUT

 +4        IF $ORDER(^ACDIIF("C",ACDVISP,0))

               DO K

               QUIT 

 +5       ;

 +6       ;If the visit was a 'TDC' ask user to duplicate with an

 +7       ;initial or re-open visit

 +8        IF $ORDER(^ACDTDC("C",ACDVISP,0))

               DO EN^ACDAUTO

               DO K

               QUIT 

 +9       ;

 +10      ;If the visit was a client service (new visit) then ask

 +11      ;the user to exactly duplicate it for other patients.

 +12       IF $ORDER(^ACDCS("C",ACDVISP,0))

               DO EN^ACDAUTO1

               DO K

               QUIT 

 +13      ;

 +14       SET ACDTOUT=1

           DO AUTO^ACDDIK

 +15       QUIT 

K         ;

 +1        KILL DIC,DIE,DA,ACDTOUT,ACDCOMC,ACDDA,ACDDFNP,DR,ACDDR,ACDIO,ACDX,ACDDOV,ACD80,ACDRPC,ACDOK,ACDN0,ACDAGE,ACDDUZZ,ACDLINE,ACDHS,ACDAGE,ACDCAGE,ACDSEX,ACDVET,ACDTRB,ACDTRBN,ACDTRBCD,ACDTRBNM,ACDSTA,ACDSTACD,ACDSTANM