- 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