- AMQQDOH ; IHS/CMI/THL - AMQQDO SUBROUTINE...PRINTS OUTPUT HEADERS;
- ;;2.0;IHS PCC SUITE;**4**;MAY 14, 2009
- ;-----
- I $D(AMQV("OPTION")),AMQV("OPTION")="COUNT" Q
- I '$D(ZTQUEUED),'$D(AMQQDIBT),AMQQTOT>1,$E(IOST,1,2)="C-" W !,"<>" R X:DTIME E S X=U
- I X=U S AMQQQUIT="" F %=AMQQOV,.1,1,2,3,5,10 S AMQP(%)=99999999999
- I $D(AMQQQUIT) Q
- IOF W @IOF
- I $E(IOST,1,2)="P-",$G(AMQQ200(3))]"" D TOP I 1
- E W #
- I AMQQCCLS="H" D HH Q
- I AMQQCCLS="D" D HD Q
- I AMQQCCLS="V" D HV Q
- S W=$S('$D(AMQQCNAM):" ",AMQQCNAM="LIVING PATIENTS":"(Alive)",1:" ")
- F AMQQHDR="HF1","HF2" D
- .W:AMQQHDR[1 "PATIENTS",?17,AMQQLABB
- .W:AMQQHDR[2 !,W,?17,"NUMBER"
- .S J=$$CHKVA(24)
- .S %=""
- .F I=9:0 S I=$O(^UTILITY("AMQQ",$J,"VAR NAME",I)) Q:'I S %=^(I) D
- ..S X=$P(%,U,3)
- ..S A=$P(%,U,2)
- ..S:'A A=1
- ..D @AMQQHDR
- .I $G(%),$P($G(^AMQQ(1,+%,0)),U,3)=9000010.01,$D(AMQQDVQU),AMQQHDR="HF1" D
- ..W ?J,"QUALIFIER"
- ..S J=J+2+20
- K W
- S %=""
- S $P(%,"-",IOM)=""
- W !,%,!
- K AMQQHDR,AMQQORCT
- Q
- ;
- HV F AMQQHDR="HF1","HF2" W:AMQQHDR[1 "VISIT NO. VISIT DATE" W:AMQQHDR[2 !?13,"AND TIME" S J=29 F I=9:0 S I=$O(^UTILITY("AMQQ",$J,"VAR NAME",I)) Q:'I S %=^(I),X=$P(%,U,3),A=$P(%,U,2) S:'A A=1 D @AMQQHDR
- HV1 S %=""
- S $P(%,"-",IOM)=""
- W !,%,!
- K AMQQHDR
- Q
- ;
- HD F AMQQHDR="HF1","HF2" D
- .W:AMQQHDR[1 "POV NO."
- .W:AMQQHDR[2 !
- .S J=9
- .F I=9:0 S I=$O(^UTILITY("AMQQ",$J,"VAR NAME",I)) Q:'I S %=^(I),X=$P(%,U,3),A=$P(%,U,2) S:'A A=1 D @AMQQHDR
- D HV1
- Q
- ;
- HH F AMQQHDR="HF1","HF2" D
- .W:AMQQHDR[1 "PROVIDERS",?19,"IHS"
- .W:AMQQHDR[2 !,?19,"CODE"
- .S J=24
- .F I=9:0 S I=$O(^UTILITY("AMQQ",$J,"VAR NAME",I)) Q:'I S %=^(I),X=$P(%,U,3),A=$P(%,U,2) S:'A A=1 D @AMQQHDR
- K W
- S %=""
- S $P(%,"-",IOM)=""
- W !,%,!
- K AMQQHDR
- Q
- ;
- HF1 I X["\" S X=$P(X,"\")
- I X'="" W ?J,X S J=J+2+$P(%,U,4) Q
- D LABCONV^AMQQDO
- S X=^AMQQ(1,+%,4,A,0)
- S Y=$P(X,U,6)
- W ?J,$P(X,U,4)
- S J=J+2+Y
- Q
- ;
- HF2 I X["\" S X=$P(X,"\",2) W ?J,X S J=J+2+$P(%,U,4) Q
- D LABCONV^AMQQDO
- S X=^AMQQ(1,+%,4,A,0)
- S Z=$P(X,U,7)
- S:Z["SERIES" Z=""
- I $P(X,U,8) S Z="#" ;_$P(%,U,4)
- I +%=179 S AMQQORCT=1+$G(AMQQORCT),Z="#"_AMQQORCT
- S Y=$P(X,U,6)
- I $P(%,U,4)>Y S Y=$P(%,U,4)
- W ?J
- I Z'="",A=1 W Z
- S J=J+2+Y
- Q
- ;
- TOP W ?7,"***** IHS Query Manager Confidential Patient Data *****"
- S %=$P(@AMQQ200(3)@(DUZ,0),U)
- S %=$P(%,",",2,9)_" "_$P(%,",")
- W !,"** Report requested by ",%
- W ?64
- S Y=DT
- X ^DD("DD")
- W Y," **",!!
- Q
- CHKVA(C) ;RETURN C+# IF VA, ELSE C
- Q $S('$D(DUZ("AG")):C,$E(DUZ("AG"))="V":C+3,1:C)
- AMQQDOH ; IHS/CMI/THL - AMQQDO SUBROUTINE...PRINTS OUTPUT HEADERS;
- +1 ;;2.0;IHS PCC SUITE;**4**;MAY 14, 2009
- +2 ;-----
- +3 IF $DATA(AMQV("OPTION"))
- IF AMQV("OPTION")="COUNT"
- QUIT
- +1 IF '$DATA(ZTQUEUED)
- IF '$DATA(AMQQDIBT)
- IF AMQQTOT>1
- IF $EXTRACT(IOST,1,2)="C-"
- WRITE !,"<>"
- READ X:DTIME
- IF '$TEST
- SET X=U
- +2 IF X=U
- SET AMQQQUIT=""
- FOR %=AMQQOV,.1,1,2,3,5,10
- SET AMQP(%)=99999999999
- +3 IF $DATA(AMQQQUIT)
- QUIT
- IOF WRITE @IOF
- +1 IF $EXTRACT(IOST,1,2)="P-"
- IF $GET(AMQQ200(3))]""
- DO TOP
- IF 1
- +2 IF '$TEST
- WRITE #
- +3 IF AMQQCCLS="H"
- DO HH
- QUIT
- +4 IF AMQQCCLS="D"
- DO HD
- QUIT
- +5 IF AMQQCCLS="V"
- DO HV
- QUIT
- +6 SET W=$SELECT('$DATA(AMQQCNAM):" ",AMQQCNAM="LIVING PATIENTS":"(Alive)",1:" ")
- +7 FOR AMQQHDR="HF1","HF2"
- Begin DoDot:1
- +8 IF AMQQHDR[1
- WRITE "PATIENTS",?17,AMQQLABB
- +9 IF AMQQHDR[2
- WRITE !,W,?17,"NUMBER"
- +10 SET J=$$CHKVA(24)
- +11 SET %=""
- +12 FOR I=9:0
- SET I=$ORDER(^UTILITY("AMQQ",$JOB,"VAR NAME",I))
- IF 'I
- QUIT
- SET %=^(I)
- Begin DoDot:2
- +13 SET X=$PIECE(%,U,3)
- +14 SET A=$PIECE(%,U,2)
- +15 IF 'A
- SET A=1
- +16 DO @AMQQHDR
- End DoDot:2
- +17 IF $GET(%)
- IF $PIECE($GET(^AMQQ(1,+%,0)),U,3)=9000010.01
- IF $DATA(AMQQDVQU)
- IF AMQQHDR="HF1"
- Begin DoDot:2
- +18 WRITE ?J,"QUALIFIER"
- +19 SET J=J+2+20
- End DoDot:2
- End DoDot:1
- +20 KILL W
- +21 SET %=""
- +22 SET $PIECE(%,"-",IOM)=""
- +23 WRITE !,%,!
- +24 KILL AMQQHDR,AMQQORCT
- +25 QUIT
- +26 ;
- HV FOR AMQQHDR="HF1","HF2"
- IF AMQQHDR[1
- WRITE "VISIT NO. VISIT DATE"
- IF AMQQHDR[2
- WRITE !?13,"AND TIME"
- SET J=29
- FOR I=9:0
- SET I=$ORDER(^UTILITY("AMQQ",$JOB,"VAR NAME",I))
- IF 'I
- QUIT
- SET %=^(I)
- SET X=$PIECE(%,U,3)
- SET A=$PIECE(%,U,2)
- IF 'A
- SET A=1
- DO @AMQQHDR
- HV1 SET %=""
- +1 SET $PIECE(%,"-",IOM)=""
- +2 WRITE !,%,!
- +3 KILL AMQQHDR
- +4 QUIT
- +5 ;
- HD FOR AMQQHDR="HF1","HF2"
- Begin DoDot:1
- +1 IF AMQQHDR[1
- WRITE "POV NO."
- +2 IF AMQQHDR[2
- WRITE !
- +3 SET J=9
- +4 FOR I=9:0
- SET I=$ORDER(^UTILITY("AMQQ",$JOB,"VAR NAME",I))
- IF 'I
- QUIT
- SET %=^(I)
- SET X=$PIECE(%,U,3)
- SET A=$PIECE(%,U,2)
- IF 'A
- SET A=1
- DO @AMQQHDR
- End DoDot:1
- +5 DO HV1
- +6 QUIT
- +7 ;
- HH FOR AMQQHDR="HF1","HF2"
- Begin DoDot:1
- +1 IF AMQQHDR[1
- WRITE "PROVIDERS",?19,"IHS"
- +2 IF AMQQHDR[2
- WRITE !,?19,"CODE"
- +3 SET J=24
- +4 FOR I=9:0
- SET I=$ORDER(^UTILITY("AMQQ",$JOB,"VAR NAME",I))
- IF 'I
- QUIT
- SET %=^(I)
- SET X=$PIECE(%,U,3)
- SET A=$PIECE(%,U,2)
- IF 'A
- SET A=1
- DO @AMQQHDR
- End DoDot:1
- +5 KILL W
- +6 SET %=""
- +7 SET $PIECE(%,"-",IOM)=""
- +8 WRITE !,%,!
- +9 KILL AMQQHDR
- +10 QUIT
- +11 ;
- HF1 IF X["\"
- SET X=$PIECE(X,"\")
- +1 IF X'=""
- WRITE ?J,X
- SET J=J+2+$PIECE(%,U,4)
- QUIT
- +2 DO LABCONV^AMQQDO
- +3 SET X=^AMQQ(1,+%,4,A,0)
- +4 SET Y=$PIECE(X,U,6)
- +5 WRITE ?J,$PIECE(X,U,4)
- +6 SET J=J+2+Y
- +7 QUIT
- +8 ;
- HF2 IF X["\"
- SET X=$PIECE(X,"\",2)
- WRITE ?J,X
- SET J=J+2+$PIECE(%,U,4)
- QUIT
- +1 DO LABCONV^AMQQDO
- +2 SET X=^AMQQ(1,+%,4,A,0)
- +3 SET Z=$PIECE(X,U,7)
- +4 IF Z["SERIES"
- SET Z=""
- +5 ;_$P(%,U,4)
- IF $PIECE(X,U,8)
- SET Z="#"
- +6 IF +%=179
- SET AMQQORCT=1+$GET(AMQQORCT)
- SET Z="#"_AMQQORCT
- +7 SET Y=$PIECE(X,U,6)
- +8 IF $PIECE(%,U,4)>Y
- SET Y=$PIECE(%,U,4)
- +9 WRITE ?J
- +10 IF Z'=""
- IF A=1
- WRITE Z
- +11 SET J=J+2+Y
- +12 QUIT
- +13 ;
- TOP WRITE ?7,"***** IHS Query Manager Confidential Patient Data *****"
- +1 SET %=$PIECE(@AMQQ200(3)@(DUZ,0),U)
- +2 SET %=$PIECE(%,",",2,9)_" "_$PIECE(%,",")
- +3 WRITE !,"** Report requested by ",%
- +4 WRITE ?64
- +5 SET Y=DT
- +6 XECUTE ^DD("DD")
- +7 WRITE Y," **",!!
- +8 QUIT
- CHKVA(C) ;RETURN C+# IF VA, ELSE C
- +1 QUIT $SELECT('$DATA(DUZ("AG")):C,$EXTRACT(DUZ("AG"))="V":C+3,1:C)
