- AZP3UTL ;UTILITY PROGRAM [ 01/31/91 1:32 PM ]
- ;FCJ 09/10/90
- VAR S FACPT=DUZ(2),(RXTOT,ND,PFAC)=0,(ANS,ODT,BDT,EDT)="",U="^"
- S Y=DT X ^DD("DD") S DATE=Y
- S:RX="Y" %ZIS("A")="Enter the device to print Pharmacy data: "
- S:RX="N" %ZIS("A")="Enter the device to print HCFA 1500 forms: "
- D ^%ZIS
- A U IO(0) W @IOF,!
- R:RX="Y" "Do you want to print an individual Pharmacy claims? (Y or N) ",ANS:100
- R:RX="N" "Do you want to print an individual HCFA 1500? (Y or N) ",ANS:100
- I (ANS="^")!(ANS="") S RX="" G EXIT
- G:ANS="Y" A1 G:ANS="N" A2 G A
- A1 R !!,"Enter the document # you wish to print. ",BDOC I BDOC="?" D LIST G A1
- I (BDOC="^")!(BDOC="") S RX="" G EXIT
- I '$D(^AZPPI(1,"B",BDOC)) W !,"INVAILID DOCUMENT NUMBER" G A1
- S EDOC=$E(BDOC,5,8),ETSTDOC=$E(BDOC,1,2)_EDOC Q
- A2 R !,"Enter the beginning document number. ",BDOC I BDOC="?" D LIST G A2
- I (BDOC="^")!(BDOC="") S RX="" G EXIT
- I '$D(^AZPPI(1,"B",BDOC)) W !,"INVAILID DOCUMENT NUMBER" G A2
- A3 R !,"Enter the ending document number. ",EDOC I EDOC="?" D LIST G A3
- I (EDOC="^")!(EDOC="") S RX="" G EXIT
- I '$D(^AZPPI(1,"B",EDOC)) W !,"INVAILID DOCUMENT NUMBER" G A3
- I $E(EDOC,3,4)'=$E(BDOC,3,4) W !,"YOU MUST PRINT BEGINNING AND ENDING DOCUMENTS FROM THE SAME FACILITY. " G A2
- S ETSTDOC=$E(EDOC,1,2)_$E(EDOC,5,8)
- EXIT K DCL,DCL1,PAT Q
- LIST R !!,"You may enter a document number to begin the list from",!,"or list will begin from first document. ex. 90YH0001 : ",DCL S:DCL="" DCL=0 Q:DCL="^"
- I DCL'=0 S DCL1=10000+$E(DCL,5,8)-1,DCL=$E(DCL,1,4)_$E(DCL1,2,5)
- F S DCL=$O(^AZPPI(1,"B",DCL)) Q:DCL="" D
- .S DCL1=0,PAT=0 F S DCL1=$O(^AZPPI(1,"B",DCL,DCL1)) Q:DCL1="" S PAT=$P(^AZPPI(1,DCL1,0),U,2),PAT=$P(^DPT(PAT,0),U) W !?5,DCL," ",PAT
- Q
- KLL ;
- K ETSTDOC,BTSTDOC,ARID,AUTH,DATA3,DATA4,DATAF,DATAF1,DOB,EMG,FAC,INSP,L1,LAB,LABC,LEND,PHY,PHY,PT,RLS,SEX,SSN,SX,TB
- KLL2 X ^%ZIS("C")
- K BDOC,EDOC,%H,%I,DATE,BDT,CTY,DATA2,DOCNO,EDT,FACPT,HRN,NM,ODT,PFAC,POP,ST,STR,ZIP
- KLL3 K ID,%,X,Y,INS,AUPNDAYS,AUPNDOB,AUPNDOD,AUPNPAT,AUPNSEX,C,DISYS,D0,D1,D2,DFN,DI,DOC1,DQ,DRGUNT,L,ND3,NDC,PDRG,PHAR,CYR,ANS,ND,ND1,ND2,DOC,DA,DIE,DR,DIC,DIC(0),DIC("A")
- K UNTS,TOTCPT,%X,%Y,BELG,EELG,INSC,PINS,SINS,DATA,DATA1,PDOS,PCPT,DOS,TOS,POS,TOT,RX,RXDSP,RXTOT,RXDT,PRX,PRX1,RXDATA,RXCST,CST,RXQTY,CRGUNT,DRGCST,ICD,PICD
- Q
- AZP3UTL ;UTILITY PROGRAM [ 01/31/91 1:32 PM ]
- +1 ;FCJ 09/10/90
- VAR SET FACPT=DUZ(2)
- SET (RXTOT,ND,PFAC)=0
- SET (ANS,ODT,BDT,EDT)=""
- SET U="^"
- +1 SET Y=DT
- XECUTE ^DD("DD")
- SET DATE=Y
- +2 IF RX="Y"
- SET %ZIS("A")="Enter the device to print Pharmacy data: "
- +3 IF RX="N"
- SET %ZIS("A")="Enter the device to print HCFA 1500 forms: "
- +4 DO ^%ZIS
- A USE IO(0)
- WRITE @IOF,!
- +1 IF RX="Y"
- READ "Do you want to print an individual Pharmacy claims? (Y or N) ",ANS:100
- +2 IF RX="N"
- READ "Do you want to print an individual HCFA 1500? (Y or N) ",ANS:100
- +3 IF (ANS="^")!(ANS="")
- SET RX=""
- GOTO EXIT
- +4 IF ANS="Y"
- GOTO A1
- IF ANS="N"
- GOTO A2
- GOTO A
- A1 READ !!,"Enter the document # you wish to print. ",BDOC
- IF BDOC="?"
- DO LIST
- GOTO A1
- +1 IF (BDOC="^")!(BDOC="")
- SET RX=""
- GOTO EXIT
- +2 IF '$DATA(^AZPPI(1,"B",BDOC))
- WRITE !,"INVAILID DOCUMENT NUMBER"
- GOTO A1
- +3 SET EDOC=$EXTRACT(BDOC,5,8)
- SET ETSTDOC=$EXTRACT(BDOC,1,2)_EDOC
- QUIT
- A2 READ !,"Enter the beginning document number. ",BDOC
- IF BDOC="?"
- DO LIST
- GOTO A2
- +1 IF (BDOC="^")!(BDOC="")
- SET RX=""
- GOTO EXIT
- +2 IF '$DATA(^AZPPI(1,"B",BDOC))
- WRITE !,"INVAILID DOCUMENT NUMBER"
- GOTO A2
- A3 READ !,"Enter the ending document number. ",EDOC
- IF EDOC="?"
- DO LIST
- GOTO A3
- +1 IF (EDOC="^")!(EDOC="")
- SET RX=""
- GOTO EXIT
- +2 IF '$DATA(^AZPPI(1,"B",EDOC))
- WRITE !,"INVAILID DOCUMENT NUMBER"
- GOTO A3
- +3 IF $EXTRACT(EDOC,3,4)'=$EXTRACT(BDOC,3,4)
- WRITE !,"YOU MUST PRINT BEGINNING AND ENDING DOCUMENTS FROM THE SAME FACILITY. "
- GOTO A2
- +4 SET ETSTDOC=$EXTRACT(EDOC,1,2)_$EXTRACT(EDOC,5,8)
- EXIT KILL DCL,DCL1,PAT
- QUIT
- LIST READ !!,"You may enter a document number to begin the list from",!,"or list will begin from first document. ex. 90YH0001 : ",DCL
- IF DCL=""
- SET DCL=0
- IF DCL="^"
- QUIT
- +1 IF DCL'=0
- SET DCL1=10000+$EXTRACT(DCL,5,8)-1
- SET DCL=$EXTRACT(DCL,1,4)_$EXTRACT(DCL1,2,5)
- +2 FOR
- SET DCL=$ORDER(^AZPPI(1,"B",DCL))
- IF DCL=""
- QUIT
- Begin DoDot:1
- +3 SET DCL1=0
- SET PAT=0
- FOR
- SET DCL1=$ORDER(^AZPPI(1,"B",DCL,DCL1))
- IF DCL1=""
- QUIT
- SET PAT=$PIECE(^AZPPI(1,DCL1,0),U,2)
- SET PAT=$PIECE(^DPT(PAT,0),U)
- WRITE !?5,DCL," ",PAT
- End DoDot:1
- +4 QUIT
- KLL ;
- +1 KILL ETSTDOC,BTSTDOC,ARID,AUTH,DATA3,DATA4,DATAF,DATAF1,DOB,EMG,FAC,INSP,L1,LAB,LABC,LEND,PHY,PHY,PT,RLS,SEX,SSN,SX,TB
- KLL2 XECUTE ^%ZIS("C")
- +1 KILL BDOC,EDOC,%H,%I,DATE,BDT,CTY,DATA2,DOCNO,EDT,FACPT,HRN,NM,ODT,PFAC,POP,ST,STR,ZIP
- KLL3 KILL ID,%,X,Y,INS,AUPNDAYS,AUPNDOB,AUPNDOD,AUPNPAT,AUPNSEX,C,DISYS,D0,D1,D2,DFN,DI,DOC1,DQ,DRGUNT,L,ND3,NDC,PDRG,PHAR,CYR,ANS,ND,ND1,ND2,DOC,DA,DIE,DR,DIC,DIC(0),DIC("A")
- +1 KILL UNTS,TOTCPT,%X,%Y,BELG,EELG,INSC,PINS,SINS,DATA,DATA1,PDOS,PCPT,DOS,TOS,POS,TOT,RX,RXDSP,RXTOT,RXDT,PRX,PRX1,RXDATA,RXCST,CST,RXQTY,CRGUNT,DRGCST,ICD,PICD
- +2 QUIT
