- QAQAHOCX ;HISC/DAD-AD HOC REPORTS: INTERFACE COMPILER ;7/12/95 14:57
- ;;1.7;QM Integration Module;;07/25/1995
- ;
- BUILD ; *** Build the Ad Hoc Report interface routine(s)
- K ^TMP($J,"QAQROU") S (QAQLEN,QAQRTNNO,QAQTAB)=0
- F QAQLN=0:0 S QAQLN=$O(^TMP($J,"QAQTXT",QAQLN)) Q:QAQLN'>0 D
- . S X=^TMP($J,"QAQTXT",QAQLN,0),^TMP($J,"QAQROU",QAQLN,0)=X
- . S QAQLEN=QAQLEN+$L(X)+2,QAQDONE='$O(^TMP($J,"QAQTXT",QAQLN))
- . I QAQLEN'<3700!QAQDONE D
- .. S QAQRTN=$S(QAQRTNNO=0:QAQPROG,1:$E(QAQPROG,1,8-$L(QAQRTNNO))_QAQRTNNO)
- .. S QAQRTNXT=$S(QAQDONE:"",1:$E(QAQPROG,1,8-$L(QAQRTNNO+1))_(QAQRTNNO+1))
- .. F QA=1:1 S X=$P($T(PROG+QA),";;",2,99) Q:X="" I @$P(X,"^") D
- ... S X="S Y="_$P(X,"^",2,99) X X S ^TMP($J,"QAQROU",QA,0)=Y
- ... Q
- .. S DIE="^TMP($J,""QAQROU"",",XCN=0,X=QAQRTN X ^%ZOSF("SAVE")
- .. K ^TMP($J,"QAQROU") S QAQLEN=0,QAQRTNNO=QAQRTNNO+1
- .. W:QAQTAB=0 ! W ?QAQTAB,QAQRTN S QAQTAB=QAQTAB+$S(QAQTAB=70:-70,1:10)
- .. Q
- . Q
- Q
- PROG ;;Include this code? (boolean) ^ Generic Ad Hoc report interface code
- ;;1^QAQRTN_" ;HISC/DAD-AD HOC REPORT INTERFACE FOR THE "_QAQFILE(0)_" FILE (#"_QAQFILE_") ;"_QAQTODAY
- ;;1^" ;;0.0;;;"
- ;;1^" ;;"_$P($T(QAQAHOCX+1),";",3,4)_";;"_$P($T(QAQAHOCX+1),";",6)
- ;;QAQRTNNO=0^" ; *** Set up required and optional variables and call Ad Hoc Rpt Gen"
- ;;QAQRTNNO=0^" S QAQMRTN=""MENU^"_QAQRTN_""",QAQORTN=""OTHER^"_QAQRTN_""",QAQDIC="_QAQFILE
- ;;(QAQRTNNO=0)&(QAQMHDR]"")^" S QAQMHDR="""_QAQMHDR_""""
- ;;QAQRTNNO=0^" D ^QAQAHOC0"
- ;;QAQRTNNO=0^" Q"
- ;;1^"MENU ; *** Build the menu array"
- ;;QAQRTNNO=0^" S QAQMENU=1"
- ;;1^" F QA=1:1 S X=$P($T(TEXT+QA),"";;"",2,99) Q:X="""" S QAQMENU(QAQMENU)=X,QAQMENU=QAQMENU+1"
- ;;1^$S(QAQRTNXT="":" Q",1:" G MENU^"_QAQRTNXT)
- ;;QAQRTNNO=0^"OTHER ; *** Set up other (optional) EN1^DIP variables, e.g."
- ;;QAQRTNNO=0^" ; *** DCOPIES,DHD,DHIT,DIOBEG,DIOEND,DIS(),IOP,PG"
- ;;QAQRTNNO=0&QAQNODAT^" K QAQFOUND S QAQFOUND=0,DHIT=""S QAQFOUND=1"""
- ;;QAQRTNNO=0&QAQNODAT^" S DIOEND=""I 'QAQFOUND W !!,""""No data found for this report !!"""""""
- ;;QAQRTNNO=0^" Q"
- ;;1^"TEXT ;;*** Sort Yes/No ^ Menu Text ^ ~Field # ^ DIR(0)"
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAQAHOCX 2123 printed Feb 18, 2025@23:57:48 Page 2
- QAQAHOCX ;HISC/DAD-AD HOC REPORTS: INTERFACE COMPILER ;7/12/95 14:57
- +1 ;;1.7;QM Integration Module;;07/25/1995
- +2 ;
- BUILD ; *** Build the Ad Hoc Report interface routine(s)
- +1 KILL ^TMP($JOB,"QAQROU")
- SET (QAQLEN,QAQRTNNO,QAQTAB)=0
- +2 FOR QAQLN=0:0
- SET QAQLN=$ORDER(^TMP($JOB,"QAQTXT",QAQLN))
- if QAQLN'>0
- QUIT
- Begin DoDot:1
- +3 SET X=^TMP($JOB,"QAQTXT",QAQLN,0)
- SET ^TMP($JOB,"QAQROU",QAQLN,0)=X
- +4 SET QAQLEN=QAQLEN+$LENGTH(X)+2
- SET QAQDONE='$ORDER(^TMP($JOB,"QAQTXT",QAQLN))
- +5 IF QAQLEN'<3700!QAQDONE
- Begin DoDot:2
- +6 SET QAQRTN=$SELECT(QAQRTNNO=0:QAQPROG,1:$EXTRACT(QAQPROG,1,8-$LENGTH(QAQRTNNO))_QAQRTNNO)
- +7 SET QAQRTNXT=$SELECT(QAQDONE:"",1:$EXTRACT(QAQPROG,1,8-$LENGTH(QAQRTNNO+1))_(QAQRTNNO+1))
- +8 FOR QA=1:1
- SET X=$PIECE($TEXT(PROG+QA),";;",2,99)
- if X=""
- QUIT
- IF @$PIECE(X,"^")
- Begin DoDot:3
- +9 SET X="S Y="_$PIECE(X,"^",2,99)
- XECUTE X
- SET ^TMP($JOB,"QAQROU",QA,0)=Y
- +10 QUIT
- End DoDot:3
- +11 SET DIE="^TMP($J,""QAQROU"","
- SET XCN=0
- SET X=QAQRTN
- XECUTE ^%ZOSF("SAVE")
- +12 KILL ^TMP($JOB,"QAQROU")
- SET QAQLEN=0
- SET QAQRTNNO=QAQRTNNO+1
- +13 if QAQTAB=0
- WRITE !
- WRITE ?QAQTAB,QAQRTN
- SET QAQTAB=QAQTAB+$SELECT(QAQTAB=70:-70,1:10)
- +14 QUIT
- End DoDot:2
- +15 QUIT
- End DoDot:1
- +16 QUIT
- PROG ;;Include this code? (boolean) ^ Generic Ad Hoc report interface code
- +1 ;;1^QAQRTN_" ;HISC/DAD-AD HOC REPORT INTERFACE FOR THE "_QAQFILE(0)_" FILE (#"_QAQFILE_") ;"_QAQTODAY
- +2 ;;1^" ;;0.0;;;"
- +3 ;;1^" ;;"_$P($T(QAQAHOCX+1),";",3,4)_";;"_$P($T(QAQAHOCX+1),";",6)
- +4 ;;QAQRTNNO=0^" ; *** Set up required and optional variables and call Ad Hoc Rpt Gen"
- +5 ;;QAQRTNNO=0^" S QAQMRTN=""MENU^"_QAQRTN_""",QAQORTN=""OTHER^"_QAQRTN_""",QAQDIC="_QAQFILE
- +6 ;;(QAQRTNNO=0)&(QAQMHDR]"")^" S QAQMHDR="""_QAQMHDR_""""
- +7 ;;QAQRTNNO=0^" D ^QAQAHOC0"
- +8 ;;QAQRTNNO=0^" Q"
- +9 ;;1^"MENU ; *** Build the menu array"
- +10 ;;QAQRTNNO=0^" S QAQMENU=1"
- +11 ;;1^" F QA=1:1 S X=$P($T(TEXT+QA),"";;"",2,99) Q:X="""" S QAQMENU(QAQMENU)=X,QAQMENU=QAQMENU+1"
- +12 ;;1^$S(QAQRTNXT="":" Q",1:" G MENU^"_QAQRTNXT)
- +13 ;;QAQRTNNO=0^"OTHER ; *** Set up other (optional) EN1^DIP variables, e.g."
- +14 ;;QAQRTNNO=0^" ; *** DCOPIES,DHD,DHIT,DIOBEG,DIOEND,DIS(),IOP,PG"
- +15 ;;QAQRTNNO=0&QAQNODAT^" K QAQFOUND S QAQFOUND=0,DHIT=""S QAQFOUND=1"""
- +16 ;;QAQRTNNO=0&QAQNODAT^" S DIOEND=""I 'QAQFOUND W !!,""""No data found for this report !!"""""""
- +17 ;;QAQRTNNO=0^" Q"
- +18 ;;1^"TEXT ;;*** Sort Yes/No ^ Menu Text ^ ~Field # ^ DIR(0)"
