DVBALD.m

DVBALD ;ALB/JLU;List Man created routine ; 01-AUG-1994

 ;;2.7;AMIE;;Apr 10, 1995

EN ; -- main entry point for DVBA DISCHARGE TYPES

 D EN^VALM("DVBA DISCHARGE TYPES")

 Q

 ;

HDR ; -- header code

 S VALMHDR(1)="This is a list of the default discharge types."

 S VALMHDR(2)="Some of these types may not be active at this site."

 Q

 ;

INIT ; -- init variables and list array

 N DVBX,DVBY

 K ^TMP("AMIE",$J),^TMP("DVBA",$J)

 S VALMCNT=0

 F DVBX=1:1 S DVBY=$T(TEXT+DVBX) S DVBY=$P(DVBY,";;",2) Q:DVBY="END"  D SETARAY^DVBALD1(DVBY)

 Q

 ;

TEXT ;these are the default discharge types

 ;;10^TRANSFER OUT

 ;;18^READMISSION TO NHCU/DOMICILIARY

 ;;31^TO NHCU FROM HOSP

 ;;32^TO DOM FROM HOSP

 ;;33^TO NHCU FROM DOM

 ;;34^DISCHARGE TO CNH

 ;;35^VA NHCU TO CNH

 ;;40^TO ASIH

 ;;41^FROM ASIH

 ;;43^TO ASIH (OTHER FACILITY)

 ;;END

 ;

HELP ; -- help code

 S X="?" D DISP^XQORM1 W !!

 Q

 ;

EXIT ; -- exit code

 D CLEAR^VALM1

 K ^TMP("AMIE",$J),DVBAQUIT,VALMCK,VALMNOD

 Q

 ;

EXPND ; -- expand code

 Q

 ;

ADD ;this is the code for the ADD action in the discharge List Man

 D FULL^VALM1

 D ADD^DVBALD1("AD")

 S VALMBCK="R"

 Q

 ;

DELETE ;this is the code for the DELETE action in the discharge List Man

 D FULL^VALM1

 D DELETE^DVBALD1

 S VALMBCK="R"

 Q

 ;

CREATE ;this is the code for the CREATE action in the discharge List Man

 D FULL^VALM1

 K ^TMP("AMIE",$J),^TMP("DVBA",$J)

 S VALMCNT=0

 D ADD^DVBALD1("CL")

 I '$D(@VALMAR@(1)) DO

 .S VAR(1,0)="0,0,0,2,0^No new discharge types were selected."

 .S VAR(2,0)="0,0,0,1,0^I will go back to the default list."

 .D WR^DVBAUTL4("VAR")

 .K VAR

 .D PAUSE^VALM1

 .D INIT

 .Q

 S VALMBCK="R"

 Q

 ;

ACCEPT ;this line tag is for the acceptance of the discharge list.

 S DVBACEPT=1

 S VALMCK="Q"

 Q

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DVBALD   1794     printed  Apr 09, 2024@20:48                                                                                                                                                                                                         Page 2

DVBALD    ;ALB/JLU;List Man created routine ; 01-AUG-1994

 +1       ;;2.7;AMIE;;Apr 10, 1995

EN        ; -- main entry point for DVBA DISCHARGE TYPES

 +1        DO EN^VALM("DVBA DISCHARGE TYPES")

 +2        QUIT 

 +3       ;

HDR       ; -- header code

 +1        SET VALMHDR(1)="This is a list of the default discharge types."

 +2        SET VALMHDR(2)="Some of these types may not be active at this site."

 +3        QUIT 

 +4       ;

INIT      ; -- init variables and list array

 +1        NEW DVBX,DVBY

 +2        KILL ^TMP("AMIE",$JOB),^TMP("DVBA",$JOB)

 +3        SET VALMCNT=0

 +4        FOR DVBX=1:1

               SET DVBY=$TEXT(TEXT+DVBX)

               SET DVBY=$PIECE(DVBY,";;",2)

               if DVBY="END"

                   QUIT 

               DO SETARAY^DVBALD1(DVBY)

 +5        QUIT 

 +6       ;

TEXT      ;these are the default discharge types

 +1       ;;10^TRANSFER OUT

 +2       ;;18^READMISSION TO NHCU/DOMICILIARY

 +3       ;;31^TO NHCU FROM HOSP

 +4       ;;32^TO DOM FROM HOSP

 +5       ;;33^TO NHCU FROM DOM

 +6       ;;34^DISCHARGE TO CNH

 +7       ;;35^VA NHCU TO CNH

 +8       ;;40^TO ASIH

 +9       ;;41^FROM ASIH

 +10      ;;43^TO ASIH (OTHER FACILITY)

 +11      ;;END

 +12      ;

HELP      ; -- help code

 +1        SET X="?"

           DO DISP^XQORM1

           WRITE !!

 +2        QUIT 

 +3       ;

EXIT      ; -- exit code

 +1        DO CLEAR^VALM1

 +2        KILL ^TMP("AMIE",$JOB),DVBAQUIT,VALMCK,VALMNOD

 +3        QUIT 

 +4       ;

EXPND     ; -- expand code

 +1        QUIT 

 +2       ;

ADD       ;this is the code for the ADD action in the discharge List Man

 +1        DO FULL^VALM1

 +2        DO ADD^DVBALD1("AD")

 +3        SET VALMBCK="R"

 +4        QUIT 

 +5       ;

DELETE    ;this is the code for the DELETE action in the discharge List Man

 +1        DO FULL^VALM1

 +2        DO DELETE^DVBALD1

 +3        SET VALMBCK="R"

 +4        QUIT 

 +5       ;

CREATE    ;this is the code for the CREATE action in the discharge List Man

 +1        DO FULL^VALM1

 +2        KILL ^TMP("AMIE",$JOB),^TMP("DVBA",$JOB)

 +3        SET VALMCNT=0

 +4        DO ADD^DVBALD1("CL")

 +5        IF '$DATA(@VALMAR@(1))

               Begin DoDot:1

 +6                SET VAR(1,0)="0,0,0,2,0^No new discharge types were selected."

 +7                SET VAR(2,0)="0,0,0,1,0^I will go back to the default list."

 +8                DO WR^DVBAUTL4("VAR")

 +9                KILL VAR

 +10               DO PAUSE^VALM1

 +11               DO INIT

 +12               QUIT 

               End DoDot:1

 +13       SET VALMBCK="R"

 +14       QUIT 

 +15      ;

ACCEPT    ;this line tag is for the acceptance of the discharge list.

 +1        SET DVBACEPT=1

 +2        SET VALMCK="Q"

 +3        QUIT 

 +4       ;