ACHSYSR.m

ACHSYSR ; IHS/ITSC/PMF - display database record for given PO; [ 10/16/2001  10:13 AM ]

 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001

 ;

 ; Displays raw database record for a given PO

 ;

 S U="^",CM=",",QT=""""

 ;

 S STOP=0

 F  D START Q:STOP

 Q

 ;

START ;

 W !!!!!!!!!!!!!!!!!!!!!!!!!

 D YEAR I STOP Q

 D NUM I STOP Q

 D SHOW

 Q

 ;

 ;

YEAR ;

 W !!,"year:",?22

 D READ^ACHSFU

 I Y="" S STOP=1 Q

 I Y'?1N W "  one digit please" G YEAR

 S YEAR=Y

 Q

NUM ;

 W !!,"number:",?22

 D READ^ACHSFU

 I Y="" S STOP=1 Q

 I Y'?5N W "  five digits please" G NUM

 S NUM=Y

 Q

 ;

SHOW ;

 W !!!!!!!

 S SS=1_YEAR_NUM

 K LIST

 S FAC=0 F  S FAC=$O(^ACHSF(FAC)) Q:'FAC  I $D(^ACHSF(FAC,"D","B",SS)) S LIST=$G(LIST)+1,LIST(FAC,$O(^ACHSF(FAC,"D","B",SS,"")))=""

 I 'LIST W !!,"NOT FOUND" Q

 ;

 S FAC=$O(LIST("")),SS=$O(LIST(FAC,""))

 S GLOB="^ACHSF("_FAC_CM_QT_"D"_QT_CM_SS_")"

 F  S GLOB=$Q(@GLOB) Q:GLOB=""  Q:GLOB'[SS  W !!,GLOB,"=",@GLOB

 W !!!

 I $$DIR^XBDIR("E","Press RETURN...")

 Q

ACHSYSR   ; IHS/ITSC/PMF - display database record for given PO; [ 10/16/2001  10:13 AM ]

 +1       ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001

 +2       ;

 +3       ; Displays raw database record for a given PO

 +4       ;

 +5        SET U="^"

           SET CM=","

           SET QT=""""

 +6       ;

 +7        SET STOP=0

 +8        FOR 

               DO START

               IF STOP

                   QUIT 

 +9        QUIT 

 +10      ;

START     ;

 +1        WRITE !!!!!!!!!!!!!!!!!!!!!!!!!

 +2        DO YEAR

           IF STOP

               QUIT 

 +3        DO NUM

           IF STOP

               QUIT 

 +4        DO SHOW

 +5        QUIT 

 +6       ;

 +7       ;

YEAR      ;

 +1        WRITE !!,"year:",?22

 +2        DO READ^ACHSFU

 +3        IF Y=""

               SET STOP=1

               QUIT 

 +4        IF Y'?1N

               WRITE "  one digit please"

               GOTO YEAR

 +5        SET YEAR=Y

 +6        QUIT 

NUM       ;

 +1        WRITE !!,"number:",?22

 +2        DO READ^ACHSFU

 +3        IF Y=""

               SET STOP=1

               QUIT 

 +4        IF Y'?5N

               WRITE "  five digits please"

               GOTO NUM

 +5        SET NUM=Y

 +6        QUIT 

 +7       ;

SHOW      ;

 +1        WRITE !!!!!!!

 +2        SET SS=1_YEAR_NUM

 +3        KILL LIST

 +4        SET FAC=0

           FOR 

               SET FAC=$ORDER(^ACHSF(FAC))

               IF 'FAC

                   QUIT 

               IF $DATA(^ACHSF(FAC,"D","B",SS))

                   SET LIST=$GET(LIST)+1

                   SET LIST(FAC,$ORDER(^ACHSF(FAC,"D","B",SS,"")))=""

 +5        IF 'LIST

               WRITE !!,"NOT FOUND"

               QUIT 

 +6       ;

 +7        SET FAC=$ORDER(LIST(""))

           SET SS=$ORDER(LIST(FAC,""))

 +8        SET GLOB="^ACHSF("_FAC_CM_QT_"D"_QT_CM_SS_")"

 +9        FOR 

               SET GLOB=$QUERY(@GLOB)

               IF GLOB=""

                   QUIT 

               IF GLOB'[SS

                   QUIT 

               WRITE !!,GLOB,"=",@GLOB

 +10       WRITE !!!

 +11       IF $$DIR^XBDIR("E","Press RETURN...")

 +12       QUIT