- GMRAUTL1 ;HIRMFO/WAA-ALLERGY UTILITIES ;12/04/92
- ;;4.0;Adverse Reaction Tracking;**33**;Mar 29, 1996;Build 5
- ;
- ; Reference to $$PROD^XUPROD supported by DBIA 4440
- ; Reference to $$TESTPAT^VADPT supported by DBIA 3744
- ;
- Q
- STPCK() ; This is to check to see if the user wanted to stop the print
- S ZTSTOP=0
- I $$S^%ZTLOAD D
- .S ZTSTOP=1 K ZTREG W !?10,"*** OUTPUT STOPPED AT USER'S REQUEST ***"
- .Q
- Q ZTSTOP
- BR ; This is a online reference card entry point
- I '$$TEST^DDBRT D Q
- .W $C(7)
- .W !,?20,"Your Terminal cannot display this Reference Card."
- .W !,?20,"Please contact IRM Service to correct this problem."
- .Q
- N X
- S X=$O(^GMRD(120.87,"B","REFERENCE CARD",0)) Q:X<1
- D WP^DDBR(120.87,X,1)
- Q
- PR ; This is a print utility for the reference card for IRM
- W ! K GMRAZIS D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q
- I $D(IO("Q")) D Q
- . S ZTRTN="PR1^GMRAUTL1",(ZTSAVE("GMRAOUT"),ZTSAVE("GMAST"),ZTSAVE("GMAEN"))=""
- . S ZTDESC="Print reference card" D ^%ZTLOAD
- . W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try Later.")
- . Q
- U IO D PR1 U IO(0)
- Q
- PR1 ; Print out the card
- N GMRAOUT,GMRACD,GMRALN,X
- I $E(IOST,1)="C" W @IOF
- S GMRACD=$O(^GMRD(120.87,"B","REFERENCE CARD",0))
- S (GMRAOUT,GMRALN)=0
- LP1 ; Main loop
- F S GMRALN=$O(^GMRD(120.87,GMRACD,1,GMRALN)) Q:GMRALN<1 D Q:GMRAOUT
- .S X=$G(^GMRD(120.87,GMRACD,1,GMRALN,0))
- .W !,X
- .I $Y>(IOSL-4) D
- ..I $E(IOST,1)="C" N DIR,DIRUT,DIROUT,DTOUT,DUOUT S DIR(0)="E" D ^DIR S:$D(DIRUT) GMRAOUT=1 W:'GMRAOUT @IOF Q
- ..W @IOF
- ..Q
- .Q
- D CLOSE^GMRAUTL
- Q
- PRDTST(GMRADFN) ; GMRA*4*33 - Remove Test Patients from Live Reports
- ; This function will return 0 if the patient should not print on the report, and 1 if the patient
- ; should appear on the report. This function will allow all patients to print on the report if the
- ; report is run in a test environment.
- ;
- I GMRADFN="" Q 0 ;DFN not defined. Should never be the case.
- I '$$PROD^XUPROD() Q 1 ;Not a production or legacy environment. Print all patients on report.
- I $$TESTPAT^VADPT(GMRADFN) Q 0 ;Production or legacy environment. Test patient. Do not print on report.
- Q 1 ;Production or legacy environment. Not a test patient. Print on report.
- ;
- VAD(DFN,DAT,LOC,NAM,SEX,SSN,RB,PRO,PID) ; Call to VADPT
- ; This call is a generic call to 1^VADPT
- ; Input:
- ; 1 DFN = Patient Internal entry number in the Patient File
- ; 2 DAT = Date for lookup
- ;
- ; Output:
- ; 3 LOC = Hospital Location
- ; 4 NAM = Full Patient name
- ; 5 SEX = Patient SEX
- ; 6 SSN = Patient SSN
- ; 7 RB = Patient Room Bed
- ; 8 PRO = Patient Provider
- ; 9 PID = Patient ID
- ;
- S DFN=$G(DFN) Q:DFN=""
- S VAINDT=$G(DAT) I VAINDT="" K VAINDT
- D 1^VADPT
- S LOC=$P(VAIN(4),U),NAM=VADM(1),SEX=VADM(5)
- S SSN=$P(VADM(2),U,2),RB=VAIN(5),PID=VA("PID")
- S PRO=$P(VAIN(2),U,2)
- D KVAR^VADPT K VA,VAROOT
- Q
- DATE(DATE) ; This Ex-Function will date the date from the DATE
- ; and convert it to the old DD("DD") style format
- ; it returns the answer in DATE
- N Y
- S Y=$$FMTE^XLFDT(DATE,1)
- S DATE=$P(Y," ")_" "_(+$P($P(Y,",")," ",2))_","_$P(Y," ",3)
- Q DATE
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAUTL1 3201 printed Jan 18, 2025@02:41:53 Page 2
- GMRAUTL1 ;HIRMFO/WAA-ALLERGY UTILITIES ;12/04/92
- +1 ;;4.0;Adverse Reaction Tracking;**33**;Mar 29, 1996;Build 5
- +2 ;
- +3 ; Reference to $$PROD^XUPROD supported by DBIA 4440
- +4 ; Reference to $$TESTPAT^VADPT supported by DBIA 3744
- +5 ;
- +6 QUIT
- STPCK() ; This is to check to see if the user wanted to stop the print
- +1 SET ZTSTOP=0
- +2 IF $$S^%ZTLOAD
- Begin DoDot:1
- +3 SET ZTSTOP=1
- KILL ZTREG
- WRITE !?10,"*** OUTPUT STOPPED AT USER'S REQUEST ***"
- +4 QUIT
- End DoDot:1
- +5 QUIT ZTSTOP
- BR ; This is a online reference card entry point
- +1 IF '$$TEST^DDBRT
- Begin DoDot:1
- +2 WRITE $CHAR(7)
- +3 WRITE !,?20,"Your Terminal cannot display this Reference Card."
- +4 WRITE !,?20,"Please contact IRM Service to correct this problem."
- +5 QUIT
- End DoDot:1
- QUIT
- +6 NEW X
- +7 SET X=$ORDER(^GMRD(120.87,"B","REFERENCE CARD",0))
- if X<1
- QUIT
- +8 DO WP^DDBR(120.87,X,1)
- +9 QUIT
- PR ; This is a print utility for the reference card for IRM
- +1 WRITE !
- KILL GMRAZIS
- DO DEV^GMRAUTL
- IF POP
- WRITE !,"PLEASE TRY LATER"
- SET GMRAOUT=1
- QUIT
- +2 IF $DATA(IO("Q"))
- Begin DoDot:1
- +3 SET ZTRTN="PR1^GMRAUTL1"
- SET (ZTSAVE("GMRAOUT"),ZTSAVE("GMAST"),ZTSAVE("GMAEN"))=""
- +4 SET ZTDESC="Print reference card"
- DO ^%ZTLOAD
- +5 WRITE !!,$SELECT($DATA(ZTSK):"Request queued...",1:"Request NOT queued please try Later.")
- +6 QUIT
- End DoDot:1
- QUIT
- +7 USE IO
- DO PR1
- USE IO(0)
- +8 QUIT
- PR1 ; Print out the card
- +1 NEW GMRAOUT,GMRACD,GMRALN,X
- +2 IF $EXTRACT(IOST,1)="C"
- WRITE @IOF
- +3 SET GMRACD=$ORDER(^GMRD(120.87,"B","REFERENCE CARD",0))
- +4 SET (GMRAOUT,GMRALN)=0
- LP1 ; Main loop
- +1 FOR
- SET GMRALN=$ORDER(^GMRD(120.87,GMRACD,1,GMRALN))
- if GMRALN<1
- QUIT
- Begin DoDot:1
- +2 SET X=$GET(^GMRD(120.87,GMRACD,1,GMRALN,0))
- +3 WRITE !,X
- +4 IF $Y>(IOSL-4)
- Begin DoDot:2
- +5 IF $EXTRACT(IOST,1)="C"
- NEW DIR,DIRUT,DIROUT,DTOUT,DUOUT
- SET DIR(0)="E"
- DO ^DIR
- if $DATA(DIRUT)
- SET GMRAOUT=1
- if 'GMRAOUT
- WRITE @IOF
- QUIT
- +6 WRITE @IOF
- +7 QUIT
- End DoDot:2
- +8 QUIT
- End DoDot:1
- if GMRAOUT
- QUIT
- +9 DO CLOSE^GMRAUTL
- +10 QUIT
- PRDTST(GMRADFN) ; GMRA*4*33 - Remove Test Patients from Live Reports
- +1 ; This function will return 0 if the patient should not print on the report, and 1 if the patient
- +2 ; should appear on the report. This function will allow all patients to print on the report if the
- +3 ; report is run in a test environment.
- +4 ;
- +5 ;DFN not defined. Should never be the case.
- IF GMRADFN=""
- QUIT 0
- +6 ;Not a production or legacy environment. Print all patients on report.
- IF '$$PROD^XUPROD()
- QUIT 1
- +7 ;Production or legacy environment. Test patient. Do not print on report.
- IF $$TESTPAT^VADPT(GMRADFN)
- QUIT 0
- +8 ;Production or legacy environment. Not a test patient. Print on report.
- QUIT 1
- +9 ;
- VAD(DFN,DAT,LOC,NAM,SEX,SSN,RB,PRO,PID) ; Call to VADPT
- +1 ; This call is a generic call to 1^VADPT
- +2 ; Input:
- +3 ; 1 DFN = Patient Internal entry number in the Patient File
- +4 ; 2 DAT = Date for lookup
- +5 ;
- +6 ; Output:
- +7 ; 3 LOC = Hospital Location
- +8 ; 4 NAM = Full Patient name
- +9 ; 5 SEX = Patient SEX
- +10 ; 6 SSN = Patient SSN
- +11 ; 7 RB = Patient Room Bed
- +12 ; 8 PRO = Patient Provider
- +13 ; 9 PID = Patient ID
- +14 ;
- +15 SET DFN=$GET(DFN)
- if DFN=""
- QUIT
- +16 SET VAINDT=$GET(DAT)
- IF VAINDT=""
- KILL VAINDT
- +17 DO 1^VADPT
- +18 SET LOC=$PIECE(VAIN(4),U)
- SET NAM=VADM(1)
- SET SEX=VADM(5)
- +19 SET SSN=$PIECE(VADM(2),U,2)
- SET RB=VAIN(5)
- SET PID=VA("PID")
- +20 SET PRO=$PIECE(VAIN(2),U,2)
- +21 DO KVAR^VADPT
- KILL VA,VAROOT
- +22 QUIT
- DATE(DATE) ; This Ex-Function will date the date from the DATE
- +1 ; and convert it to the old DD("DD") style format
- +2 ; it returns the answer in DATE
- +3 NEW Y
- +4 SET Y=$$FMTE^XLFDT(DATE,1)
- +5 SET DATE=$PIECE(Y," ")_" "_(+$PIECE($PIECE(Y,",")," ",2))_","_$PIECE(Y," ",3)
- +6 QUIT DATE